ESMF_CFIOEosFileCreate Subroutine

public subroutine ESMF_CFIOEosFileCreate(cfio, rc)

ESMF_CFIOEosFileCreate – Create a CFIO output file with meta data

Arguments

Type IntentOptional Attributes Name
type(ESMF_CFIO), intent(inout) :: cfio

a CFIO object
integer, intent(out), optional :: rc

Error return code: 0 all is well -1 Time increment is 0 -2 allocate memory error -3 Num of int/char/real elements and Cnt don’t match -12 error determining default precision -18 incorrect time increment -30 can’t open file -31 error from NF90_DEF_DIM -32 error from NF90_DEF_VAR (dimension variable) -33 error from NF90_PUT_ATT (dimension attribute) -34 error from NF90_DEF_VAR (variable) -35 error from NF90_PUT_ATT (variable attribute) -36 error from NF90_PUT_ATT (global attribute) -37 error from NF90_ENDDEF -38 error from NF90_PUT_VAR (dimension variable) -39 Num of real var elements and Cnt differ -55 error from NF90_REDEF (enter define mode) -56 error from NF90_ENDDEF (exit define mode)

Calls

proc~~esmf_cfioeosfilecreate~~CallsGraph proc~esmf_cfioeosfilecreate ESMF_CFIOEosFileCreate eos_putcharatt eos_putcharatt proc~esmf_cfioeosfilecreate->eos_putcharatt eos_putintatt eos_putintatt proc~esmf_cfioeosfilecreate->eos_putintatt eos_putrealatt eos_putrealatt proc~esmf_cfioeosfilecreate->eos_putrealatt proc~err err proc~esmf_cfioeosfilecreate->proc~err proc~getlist getList proc~esmf_cfioeosfilecreate->proc~getlist proc~getmaxlencnt getMaxLenCnt proc~esmf_cfioeosfilecreate->proc~getmaxlencnt proc~identifydim IdentifyDim proc~esmf_cfioeosfilecreate->proc~identifydim proc~getlist->proc~getmaxlencnt

Source Code

      subroutine ESMF_CFIOEosFileCreate (cfio, rc)
!
! !INPUT PARAMETERS:
!
      type(ESMF_CFIO), intent(inout) :: cfio       !! a CFIO object
!
! !OUTPUT PARAMETERS:
!
      integer, intent(out), OPTIONAL :: rc      !! Error return code:
                      !! 0   all is well
                      !! -1 Time increment is 0
                      !! -2  allocate memory error
                      !! -3  Num of int/char/real elements and Cnt don't match
                      !! -12  error determining default precision
                      !! -18 incorrect time increment
                      !! -30 can't open file
                      !! -31 error from NF90_DEF_DIM
                      !! -32 error from NF90_DEF_VAR (dimension variable)
                      !! -33 error from NF90_PUT_ATT (dimension attribute)
                      !! -34 error from NF90_DEF_VAR (variable)
                      !! -35  error from NF90_PUT_ATT (variable attribute)
                      !! -36  error from NF90_PUT_ATT (global attribute)
                      !! -37  error from NF90_ENDDEF
                      !! -38  error from NF90_PUT_VAR (dimension variable)
                      !! -39 Num of real var elements and Cnt differ
                      !! -55  error from NF90_REDEF (enter define mode)
                      !! -56  error from NF90_ENDDEF (exit define mode)
!
!------------------------------------------------------------------------------
       integer :: i, n, maxLen, rtcode
       character (len=MVARLEN), pointer :: vname(:), vtitle(:), vunits(:)
       integer, pointer :: kmvar(:)
       real, pointer :: valid_range(:,:), packing_range(:,:)

       allocate(vname(cfio%mVars), vtitle(cfio%mVars), vunits(cfio%mVars), &
                kmvar(cfio%mVars), valid_range(2,cfio%mVars), packing_range(2,cfio%mVars))

       do i = 1, cfio%mVars
          vname(i) = trim(cfio%varObjs(i)%vName)
          vtitle(i) = trim(cfio%varObjs(i)%vTitle)
          vunits(i) = trim(cfio%varObjs(i)%vUnits)
          kmvar(i) = cfio%grids(1)%km
          if ( cfio%varObjs(i)%twoDimVar ) kmvar(i) = 0
          valid_range(1,i) = cfio%varObjs(i)%validRange(1)
          valid_range(2,i) = cfio%varObjs(i)%validRange(2)
          packing_range(1,i) = cfio%varObjs(i)%packingRange(1)
          packing_range(2,i) = cfio%varObjs(i)%packingRange(2)
       enddo

       call EOS_Create_ (cfio, trim(cfio%fName), trim(cfio%title), trim(cfio%source),   &
               trim(cfio%contact), cfio%varObjs(1)%amiss,                         &
               cfio%grids(1)%im, cfio%grids(1)%jm, cfio%grids(1)%km, cfio%grids(1)%lon,  &
               cfio%grids(1)%lat, cfio%grids(1)%lev, trim(cfio%grids(1)%levUnits),       &
               cfio%date, cfio%begTime,  cfio%timeInc, cfio%mVars, vname, vtitle,        &
               vunits, kmvar, valid_range, packing_range, cfio%prec, cfio%fid, rtcode )

!      put global attributes
       call EOS_PutCharAtt(cfio%fid,'Conventions',len(trim(cfio%convention))&
                             ,cfio%convention, rtcode )
       if (err("can't write Conventions",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid, 'title', len(trim(cfio%title)),        &
                             cfio%title, rtcode )
       if (err("can't write title",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid, 'history', len(trim(cfio%history)),    &
                             cfio%history, rtcode )
       if (err("can't write history",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid,'institution',                          &
                            len(trim(cfio%institution)),                     &
                            cfio%institution, rtcode )
       if (err("can't write institution",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid, 'source', len(trim(cfio%source)),      &
                             cfio%source, rtcode )
       if (err("can't write source",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid,'references',len(trim(cfio%references)),&
                             cfio%references, rtcode )
       if (err("can't write references",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid,'comment',len(trim(cfio%comment)),      &
                             cfio%comment, rtcode )
       if (err("can't write comment",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

       call EOS_PutCharAtt(cfio%fid, 'contact', len(trim(cfio%contact)),    &
                             cfio%contact, rtcode )
       if (err("can't write contact",rtcode,rtcode) .lt. 0) then
          if ( present(rc) ) rc = rtcode
          return
       end if

!      get integer attributes from iList
       if ( associated(cfio%iList) ) then
          call getMaxLenCnt(maxLen, cfio%nAttInt, iList=cfio%iList)
          allocate(cfio%attIntNames(cfio%nAttInt),                           &
                   cfio%attIntCnts(cfio%nAttInt),                            &
                   cfio%attInts(cfio%nAttInt,maxLen), stat=rtcode)
          if (err("can't allocate mem: attIntCnts",rtcode,-2) .lt. 0) then
             if ( present(rc) ) rc = rtcode
             return
          end if

          call getList(iList=cfio%iList, intAttNames=cfio%attIntNames,       &
                       intAttCnts=cfio%attIntCnts, intAtts=cfio%attInts )
       end if

!      write user defined integer attributes
       if ( cfio%nAttInt .gt. 0 ) then
          do i = 1, cfio%nAttInt
             if ( cfio%attIntCnts(i) .gt. size(cfio%attInts(i,:)) )  then
                rtcode=err("EosFileCreate: Num of int elements and Cnt differ"  &
                            ,-3,-3)
                if ( present(rc) ) rc = rtcode
                return
             end if

             call EOS_PutIntAtt(cfio%fid, cfio%attIntNames(i),              &
                                 cfio%attIntCnts(i), cfio%attInts(i,:),      &
                                 cfio%prec, rtcode )
             if (err("error in EOS_PutIntAtt",rtcode,rtcode) .lt. 0) then
                if ( present(rc) ) rc = rtcode
                return
             end if

          end do
       end if

!      get real attributes from rList
       if ( associated(cfio%rList) ) then
          call getMaxLenCnt(maxLen, cfio%nAttReal, rList=cfio%rList)
          allocate(cfio%attRealNames(cfio%nAttReal),                       &
                   cfio%attRealCnts(cfio%nAttReal),                        &
                   cfio%attReals(cfio%nAttReal,maxLen), stat=rtcode)
          if (err("can't allocate mem: attRealNames",rtcode,-2) .lt. 0) then
             if ( present(rc) ) rc = rtcode
             return
          end if

          call getList(rList=cfio%rList, realAttNames=cfio%attRealNames,   &
                       realAttCnts=cfio%attRealCnts, realAtts=cfio%attReals )
          do i = 1, cfio%nAttReal
          end do
       end if

!      write user defined real attributes
       if ( cfio%nAttReal .gt. 0 ) then
          do i = 1, cfio%nAttReal
             if ( cfio%attRealCnts(i) .gt. size(cfio%attReals(i,:)) )  then
                rtcode=err("EosFileCreate: Num of real elements and Cnt differ" &
                            ,-3,-3)
                if ( present(rc) ) rc = rtcode
                return
             end if
             call EOS_PutRealAtt(cfio%fid, cfio%attRealNames(i),            &
                                 cfio%attRealCnts(i),                        &
                                 cfio%attReals(i,1:cfio%attRealCnts(i)),     &
                                 cfio%prec, rtcode )
             if (err("error in EOS_PutRealAtt",rtcode,rtcode) .lt. 0) then
                if ( present(rc) ) rc = rtcode
                return
             end if
          end do
       end if

!      get char attributes from cList
       if ( associated(cfio%cList) ) then
          call getMaxLenCnt(maxLen, cfio%nAttChar, cList=cfio%cList)
          allocate(cfio%attCharNames(cfio%nAttChar),                      &
                   cfio%attCharCnts(cfio%nAttChar),                       &
                   cfio%attChars(cfio%nAttChar), stat=rtcode)
          if (err("can't allocate mem: attCharNames",rtcode,-2) .lt. 0) then
             if ( present(rc) ) rc = rtcode
             return
          end if
          call getList(cList=cfio%cList, charAttNames=cfio%attCharNames,  &
                       charAttCnts=cfio%attCharCnts, charAtts=cfio%attChars )
       end if

!      write user defined char attributes
       if ( cfio%nAttChar .gt. 0 ) then
          do i = 1, cfio%nAttChar
             call EOS_PutCharAtt(cfio%fid, cfio%attCharNames(i),       &
                                 cfio%attCharCnts(i), cfio%attChars(i), &
                                 rtcode )
             if (err("error in EOS_PutCharAtt",rtcode,rtcode) .lt. 0) then
                if ( present(rc) ) rc = rtcode
                return
             end if
          end do
       end if

       cfio%isOpen = .true.

       rtcode = 0

       if ( present(rc) ) rc = rtcode

      end subroutine ESMF_CFIOEosFileCreate