New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11573 for NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM – NEMO

Ignore:
Timestamp:
2019-09-19T11:18:03+02:00 (5 years ago)
Author:
jchanut
Message:

#2222, merged with trunk

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM/in_out_manager.F90

    r10817 r11573  
    8080   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30) 
    8181   INTEGER       ::   ninist                      !: initial state output flag (0/1) 
    82    INTEGER       ::   nwrite                      !: model standard output frequency 
    83    INTEGER       ::   nstock                      !: restart file frequency 
    84    INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times 
    8582 
    8683   !!---------------------------------------------------------------------- 
    … …  
    167164   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9 
    168165   CHARACTER(lc) ::   ctmp10                !: temporary character 10 
    169    CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    170    CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
    171166   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always) 
    172167   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM/iom.F90

    r10817 r11573  
    5858   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 
    5959   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 
    60    PUBLIC iom_use, iom_context_finalize 
     60   PUBLIC iom_use, iom_context_finalize, iom_miss_val 
    6161 
    6262   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    212212          CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 
    213213          CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 
    214           ! 
    215 # if defined key_floats 
    216214          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 
    217 # endif 
    218215# if defined key_si3 
    219216          CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    … …  
    697694      clname   = trim(cdname) 
    698695      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    699          iln    = INDEX(clname,'/')  
     696!FUS         iln    = INDEX(clname,'/')  
     697         iln    = INDEX(clname,'/',BACK=.true.)  ! FUS: to insert the nest index at the right location within the string, the last / has to be found (search from the right to left) 
    700698         cltmpn = clname(1:iln) 
    701699         clname = clname(iln+1:LEN_TRIM(clname)) 
    … …  
    835833 
    836834 
    837    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
     835   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )   
    838836      !!----------------------------------------------------------------------- 
    839837      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    844842      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    845843      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
    846       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     844      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
     845      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    847846      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    848847      ! 
    … …  
    874873               iiv = iiv + 1 
    875874               IF( iiv <= jpmax_vars ) THEN 
    876                   iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims ) 
     875                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld ) 
    877876               ELSE 
    878877                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   & 
    … …  
    892891               ENDIF 
    893892               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
     893               IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld( iiv) 
    894894            ENDIF 
    895895         ENDIF 
    … …  
    12701270               !--- overlap areas and extra hallows (mpp) 
    12711271               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1272                   CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' ) 
     1272                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
    12731273               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    12741274                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    12751275                  IF( icnt(3) == inlev ) THEN 
    1276                      CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
     1276                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
    12771277                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    12781278                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    … …  
    12991299            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    13001300            IF(idom /= jpdom_unknown ) then 
    1301                 CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
     1301                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    13021302            ENDIF 
    13031303         ELSEIF( PRESENT(pv_r2d) ) THEN 
    … …  
    13061306            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    13071307            IF(idom /= jpdom_unknown ) THEN 
    1308                 CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0') 
     1308                CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    13091309            ENDIF 
    13101310         ELSEIF( PRESENT(pv_r1d) ) THEN 
    … …  
    16691669      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    16701670      REAL(wp)        , INTENT(in) ::   pfield0d 
    1671       REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     1671!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    16721672#if defined key_iomput 
    1673       zz(:,:)=pfield0d 
    1674       CALL xios_send_field(cdname, zz) 
    1675       !CALL xios_send_field(cdname, (/pfield0d/))  
     1673!!clem      zz(:,:)=pfield0d 
     1674!!clem      CALL xios_send_field(cdname, zz) 
     1675      CALL xios_send_field(cdname, (/pfield0d/))  
    16761676#else 
    16771677      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    19791979      ! Cell vertices on boundries 
    19801980      DO jn = 1, 4 
    1981          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
    1982          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
     1981         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
     1982         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
    19831983      END DO 
    19841984      ! 
    … …  
    22392239      CHARACTER(LEN=20)  ::   clfreq 
    22402240      CHARACTER(LEN=20)  ::   cldate 
     2241      CHARACTER(LEN=256) ::   cltmpn                 !FUS needed for correct path with AGRIF 
     2242      INTEGER            ::   iln                    !FUS needed for correct path with AGRIF 
    22412243      INTEGER            ::   idx 
    22422244      INTEGER            ::   jn 
    … …  
    23212323            END DO 
    23222324            ! 
    2323             IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     2325!FUS            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     2326!FUS see comment line 700  
     2327            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 
     2328             iln    = INDEX(clname,'/',BACK=.true.) 
     2329             cltmpn = clname(1:iln) 
     2330             clname = clname(iln+1:LEN_TRIM(clname)) 
     2331             clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     2332            ENDIF 
     2333!FUS  
    23242334            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    23252335            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
    … …  
    23892399   !!   NOT 'key_iomput'                               a few dummy routines 
    23902400   !!---------------------------------------------------------------------- 
    2391  
    23922401   SUBROUTINE iom_setkt( kt, cdname ) 
    23932402      INTEGER         , INTENT(in)::   kt  
    … …  
    24042413 
    24052414   LOGICAL FUNCTION iom_use( cdname ) 
    2406       !!---------------------------------------------------------------------- 
    2407       !!---------------------------------------------------------------------- 
    24082415      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    2409       !!---------------------------------------------------------------------- 
    24102416#if defined key_iomput 
    24112417      iom_use = xios_field_is_active( cdname ) 
    … …  
    24142420#endif 
    24152421   END FUNCTION iom_use 
    2416     
     2422 
     2423   SUBROUTINE iom_miss_val( cdname, pmiss_val ) 
     2424      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
     2425      REAL(wp)        , INTENT(out) ::   pmiss_val    
     2426#if defined key_iomput 
     2427      ! get missing value 
     2428      CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 
     2429#else 
     2430      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
     2431#endif 
     2432   END SUBROUTINE iom_miss_val 
     2433   
    24172434   !!====================================================================== 
    24182435END MODULE iom 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM/iom_nf90.F90

    r10522 r11573  
    187187 
    188188 
    189    FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )   
     189   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld )   
    190190      !!----------------------------------------------------------------------- 
    191191      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    198198      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
    199199      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     200      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    200201      ! 
    201202      INTEGER                        ::   iom_nf90_varid   ! iom variable Id 
    … …  
    251252         ENDIF 
    252253         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv) 
     254         IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld(kiv) 
    253255      ELSE   
    254256         iom_nf90_varid = -1   !   variable not found, return error code: -1 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/IOM/restart.F90

    r10425 r11573  
    7070         IF( ln_rst_list ) THEN 
    7171            nrst_lst = 1 
    72             nitrst = nstocklist( nrst_lst ) 
     72            nitrst = nn_stocklist( nrst_lst ) 
    7373         ELSE 
    7474            nitrst = nitend 
    7575         ENDIF 
    7676      ENDIF 
     77       
     78      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
    7779 
    7880      ! frequency-based restart dumping (nn_stock) 
    79       IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN    
     81      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN    
    8082         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    81          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     83         nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    8284         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    8385      ENDIF 
    … …  
    8587      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1) 
    8688      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    87       IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
     89      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    8890         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
    8991            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    … …  
    184186         lrst_oce = .FALSE. 
    185187            IF( ln_rst_list ) THEN 
    186                nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
    187                nitrst = nstocklist( nrst_lst ) 
     188               nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1)) 
     189               nitrst = nn_stocklist( nrst_lst ) 
    188190            ENDIF 
    189191      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.