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 12143 for NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/IOM – NEMO

Ignore:
Timestamp:
2019-12-10T12:57:49+01:00 (4 years ago)
Author:
mathiot
Message:

update ENHANCE-02_ISF_nemo to 12072 (sette in progress)

Location:
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/IOM
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/IOM/in_out_manager.F90

    r10817 r12143  
    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/ENHANCE-02_ISF_nemo/src/OCE/IOM/iom.F90

    r11521 r12143  
    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) /) ) 
    … …  
    686683      clname   = trim(cdname) 
    687684      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    688          iln    = INDEX(clname,'/')  
     685!FUS         iln    = INDEX(clname,'/')  
     686         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) 
    689687         cltmpn = clname(1:iln) 
    690688         clname = clname(iln+1:LEN_TRIM(clname)) 
    … …  
    824822 
    825823 
    826    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
     824   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )   
    827825      !!----------------------------------------------------------------------- 
    828826      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    833831      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    834832      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
    835       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     833      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
     834      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    836835      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    837836      ! 
    … …  
    863862               iiv = iiv + 1 
    864863               IF( iiv <= jpmax_vars ) THEN 
    865                   iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims ) 
     864                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld ) 
    866865               ELSE 
    867866                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   & 
    … …  
    881880               ENDIF 
    882881               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
     882               IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld( iiv) 
    883883            ENDIF 
    884884         ENDIF 
    … …  
    12591259               !--- overlap areas and extra hallows (mpp) 
    12601260               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1261                   CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' ) 
     1261                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
    12621262               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    12631263                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    12641264                  IF( icnt(3) == inlev ) THEN 
    1265                      CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
     1265                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
    12661266                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    12671267                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    … …  
    12881288            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    12891289            IF(idom /= jpdom_unknown ) then 
    1290                 CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
     1290                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    12911291            ENDIF 
    12921292         ELSEIF( PRESENT(pv_r2d) ) THEN 
    … …  
    12951295            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    12961296            IF(idom /= jpdom_unknown ) THEN 
    1297                 CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0') 
     1297                CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    12981298            ENDIF 
    12991299         ELSEIF( PRESENT(pv_r1d) ) THEN 
    … …  
    16581658      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    16591659      REAL(wp)        , INTENT(in) ::   pfield0d 
    1660       REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     1660!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    16611661#if defined key_iomput 
    1662       zz(:,:)=pfield0d 
    1663       CALL xios_send_field(cdname, zz) 
    1664       !CALL xios_send_field(cdname, (/pfield0d/))  
     1662!!clem      zz(:,:)=pfield0d 
     1663!!clem      CALL xios_send_field(cdname, zz) 
     1664      CALL xios_send_field(cdname, (/pfield0d/))  
    16651665#else 
    16661666      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    19681968      ! Cell vertices on boundries 
    19691969      DO jn = 1, 4 
    1970          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
    1971          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
     1970         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
     1971         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
    19721972      END DO 
    19731973      ! 
    … …  
    22282228      CHARACTER(LEN=20)  ::   clfreq 
    22292229      CHARACTER(LEN=20)  ::   cldate 
     2230      CHARACTER(LEN=256) ::   cltmpn                 !FUS needed for correct path with AGRIF 
     2231      INTEGER            ::   iln                    !FUS needed for correct path with AGRIF 
    22302232      INTEGER            ::   idx 
    22312233      INTEGER            ::   jn 
    … …  
    23102312            END DO 
    23112313            ! 
    2312             IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     2314!FUS            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     2315!FUS see comment line 700  
     2316            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 
     2317             iln    = INDEX(clname,'/',BACK=.true.) 
     2318             cltmpn = clname(1:iln) 
     2319             clname = clname(iln+1:LEN_TRIM(clname)) 
     2320             clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     2321            ENDIF 
     2322!FUS  
    23132323            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    23142324            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
    … …  
    23782388   !!   NOT 'key_iomput'                               a few dummy routines 
    23792389   !!---------------------------------------------------------------------- 
    2380  
    23812390   SUBROUTINE iom_setkt( kt, cdname ) 
    23822391      INTEGER         , INTENT(in)::   kt  
    … …  
    23932402 
    23942403   LOGICAL FUNCTION iom_use( cdname ) 
    2395       !!---------------------------------------------------------------------- 
    2396       !!---------------------------------------------------------------------- 
    23972404      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    2398       !!---------------------------------------------------------------------- 
    23992405#if defined key_iomput 
    24002406      iom_use = xios_field_is_active( cdname ) 
    … …  
    24032409#endif 
    24042410   END FUNCTION iom_use 
    2405     
     2411 
     2412   SUBROUTINE iom_miss_val( cdname, pmiss_val ) 
     2413      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
     2414      REAL(wp)        , INTENT(out) ::   pmiss_val    
     2415#if defined key_iomput 
     2416      ! get missing value 
     2417      CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 
     2418#else 
     2419      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
     2420#endif 
     2421   END SUBROUTINE iom_miss_val 
     2422   
    24062423   !!====================================================================== 
    24072424END MODULE iom 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/IOM/iom_nf90.F90

    r10522 r12143  
    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/ENHANCE-02_ISF_nemo/src/OCE/IOM/restart.F90

    r11823 r12143  
    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...) 
    … …  
    173175         lrst_oce = .FALSE. 
    174176            IF( ln_rst_list ) THEN 
    175                nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
    176                nitrst = nstocklist( nrst_lst ) 
     177               nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1)) 
     178               nitrst = nn_stocklist( nrst_lst ) 
    177179            ENDIF 
    178180      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.