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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals
      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/IOM/iom.F90

    r12178 r12928  
    2929   USE lib_mpp           ! MPP library 
    3030#if defined key_iomput 
    31    USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain 
    32    USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
     31   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    3332   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    3433#if defined key_si3 
     
    4645#endif 
    4746   USE lib_fortran  
    48    USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     47   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 
    4948 
    5049   IMPLICIT NONE 
     
    5655   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    5756#endif 
    58    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 
     57   PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var 
    5958   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 
    60    PUBLIC iom_use, iom_context_finalize, iom_miss_val 
     59   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 
    6160 
    6261   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    6362   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    64    PRIVATE iom_p1d, iom_p2d, iom_p3d 
     63   PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d 
    6564#if defined key_iomput 
    6665   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 
    67    PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
     66   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 
    6867   PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 
    6968# endif 
     
    8382   END INTERFACE 
    8483   INTERFACE iom_put 
    85       MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 
     84      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d 
    8685   END INTERFACE iom_put 
    8786   
     87   !! * Substitutions 
     88#  include "do_loop_substitute.h90" 
    8889   !!---------------------------------------------------------------------- 
    8990   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    9394CONTAINS 
    9495 
    95    SUBROUTINE iom_init( cdname, fname, ld_tmppatch )  
     96   SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef )  
    9697      !!---------------------------------------------------------------------- 
    9798      !!                     ***  ROUTINE   *** 
     
    103104      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
    104105      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
     106      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    105107#if defined key_iomput 
    106108      ! 
     
    108110      TYPE(xios_date)     :: start_date 
    109111      CHARACTER(len=lc) :: clname 
    110       INTEGER           :: ji, jkmin 
     112      INTEGER             :: irefyear, irefmonth, irefday 
     113      INTEGER           :: ji 
    111114      LOGICAL :: llrst_context              ! is context related to restart 
    112115      ! 
    113116      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     117      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    114118      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    115119      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    116120      INTEGER ::   nldj_save, nlej_save    !: 
     121      LOGICAL ::   ll_closedef = .TRUE. 
    117122      !!---------------------------------------------------------------------- 
    118123      ! 
     
    129134         IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    130135      ENDIF 
     136      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    131137      ! 
    132138      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 
     
    139145 
    140146      ! Calendar type is now defined in xml file  
     147      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900 
     148      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 
     149      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01 
     150 
    141151      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    142       CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 
     152      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    143153          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    144       CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), & 
     154      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    145155          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    146       CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), & 
     156      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    147157          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    148158      END SELECT 
     
    195205      ! vertical grid definition 
    196206      IF(.NOT.llrst_context) THEN 
    197           CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d ) 
    198           CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d ) 
    199           CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d ) 
    200           CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d ) 
    201  
     207          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d ) 
     208          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d ) 
     209          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
     210          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     211 
     212          ! ABL 
     213          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)  
     214             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom 
     215             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp 
     216             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp 
     217          ENDIF 
     218          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 
     219          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 
     220           
    202221          ! Add vertical grid bounds 
    203           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    204           zt_bnds(2,:        ) = gdept_1d(:) 
    205           zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
    206           zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
    207           zw_bnds(1,:        ) = gdepw_1d(:) 
    208           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    209           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    210           CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 
    211           CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 
    212           CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 
    213           CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 
     222          zt_bnds(2,:      ) = gdept_1d(:) 
     223          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1) 
     224          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1) 
     225          zw_bnds(1,:      ) = gdepw_1d(:) 
     226          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     227          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     228          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
     229          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
     230          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
     231          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     232 
     233          ! ABL 
     234          za_bnds(1,:) = ghw_abl(1:jpkam1) 
     235          za_bnds(2,:) = ghw_abl(2:jpka  ) 
     236          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 
     237          za_bnds(1,:) = ght_abl(2:jpka  ) 
     238          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka) 
     239          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 
     240 
    214241          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 
    215242# if defined key_si3 
     
    223250          CALL iom_set_axis_attr( "icbcla", class_num ) 
    224251          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )   ! strange syntaxe and idea... 
     252          CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) )   ! strange syntaxe and idea... 
    225253          CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )   ! strange syntaxe and idea... 
     254          CALL iom_set_axis_attr( "basin"  , (/ (REAL(ji,wp), ji=1,5) /) ) 
    226255      ENDIF 
    227256      ! 
     
    243272      ENDIF 
    244273      ! 
    245       ! end file definition 
    246       dtime%second = rdt 
     274      ! set time step length 
     275      dtime%second = rn_Dt 
    247276      CALL xios_set_timestep( dtime ) 
    248       CALL xios_close_context_definition() 
    249       CALL xios_update_calendar( 0 ) 
     277      ! 
     278      ! conditional closure of context definition 
     279      IF ( ll_closedef ) CALL iom_init_closedef 
    250280      ! 
    251281      DEALLOCATE( zt_bnds, zw_bnds ) 
     
    258288      ! 
    259289   END SUBROUTINE iom_init 
     290 
     291   SUBROUTINE iom_init_closedef 
     292      !!---------------------------------------------------------------------- 
     293      !!            ***  SUBROUTINE iom_init_closedef  *** 
     294      !!---------------------------------------------------------------------- 
     295      !! 
     296      !! ** Purpose : Closure of context definition 
     297      !! 
     298      !!---------------------------------------------------------------------- 
     299 
     300#if defined key_iomput 
     301      CALL xios_close_context_definition() 
     302      CALL xios_update_calendar( 0 ) 
     303#else 
     304      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings 
     305#endif 
     306 
     307   END SUBROUTINE iom_init_closedef 
    260308 
    261309   SUBROUTINE iom_set_rstw_var_active(field) 
     
    361409   IF(cdmdl == "OPA") THEN 
    362410!from restart.F90 
    363    CALL iom_set_rstw_var_active("rdt") 
     411   CALL iom_set_rstw_var_active("rn_Dt") 
    364412   IF ( .NOT. ln_diurnal_only ) THEN 
    365413        CALL iom_set_rstw_var_active('ub'  ) 
     
    375423        CALL iom_set_rstw_var_active('sshn') 
    376424        CALL iom_set_rstw_var_active('rhop') 
    377      ! extra variable needed for the ice sheet coupling 
    378         IF ( ln_iscpl ) THEN 
    379              CALL iom_set_rstw_var_active('tmask') 
    380              CALL iom_set_rstw_var_active('umask') 
    381              CALL iom_set_rstw_var_active('vmask') 
    382              CALL iom_set_rstw_var_active('smask') 
    383              CALL iom_set_rstw_var_active('e3t_n') 
    384              CALL iom_set_rstw_var_active('e3u_n') 
    385              CALL iom_set_rstw_var_active('e3v_n') 
    386              CALL iom_set_rstw_var_active('gdepw_n') 
    387         END IF 
    388425      ENDIF 
    389426      IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 
     
    410447 
    411448        i = 0 
    412         i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar" 
     449        i = i + 1; fields(i)%vname="rn_Dt";            fields(i)%grid="grid_scalar" 
    413450        i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D" 
    414451        i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D" 
     
    627664 
    628665 
    629    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     666   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
    630667      !!--------------------------------------------------------------------- 
    631668      !!                   ***  SUBROUTINE  iom_open  *** 
     
    640677      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    641678      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
     679      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open 
    642680      ! 
    643681      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     
    694732      clname   = trim(cdname) 
    695733      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    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) 
     734         iln    = INDEX(clname,'/')  
    698735         cltmpn = clname(1:iln) 
    699736         clname = clname(iln+1:LEN_TRIM(clname)) 
     
    786823      ENDIF 
    787824      IF( istop == nstop ) THEN   ! no error within this routine 
    788          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
     825         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
    789826      ENDIF 
    790827      ! 
     
    806843      CHARACTER(LEN=100)    ::   clinfo    ! info character 
    807844      !--------------------------------------------------------------------- 
     845      ! 
     846      IF( iom_open_init == 0 )   RETURN   ! avoid to use iom_file(jf)%nfid that us not yet initialized 
    808847      ! 
    809848      clinfo = '                    iom_close ~~~  ' 
     
    11401179            WRITE(cldmspc , fmt='(i1)') idmspc 
    11411180            ! 
    1142             IF(     idmspc <  irankpv ) THEN  
    1143                CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1144                   &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1145             ELSEIF( idmspc == irankpv ) THEN 
     1181            !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1182            !IF(     idmspc <  irankpv ) THEN  
     1183            !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1184            !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
     1185            !ELSEIF( idmspc == irankpv ) THEN 
     1186            IF( idmspc == irankpv ) THEN 
    11461187               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    11471188                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
     
    13401381   END SUBROUTINE iom_get_123d 
    13411382 
     1383   SUBROUTINE iom_get_var( cdname, z2d) 
     1384      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
     1385      REAL(wp), DIMENSION(jpi,jpj) ::   z2d  
     1386#if defined key_iomput 
     1387      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN 
     1388         z2d(:,:) = 0._wp 
     1389         CALL xios_recv_field( cdname, z2d) 
     1390      ENDIF 
     1391#else 
     1392      IF( .FALSE. )   WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings 
     1393#endif 
     1394   END SUBROUTINE iom_get_var 
     1395 
    13421396 
    13431397   FUNCTION iom_getszuld ( kiomid )   
     
    17091763   END SUBROUTINE iom_p3d 
    17101764 
     1765   SUBROUTINE iom_p4d( cdname, pfield4d ) 
     1766      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1767      REAL(wp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1768#if defined key_iomput 
     1769      CALL xios_send_field(cdname, pfield4d) 
     1770#else 
     1771      IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
     1772#endif 
     1773   END SUBROUTINE iom_p4d 
     1774 
     1775 
    17111776#if defined key_iomput 
    17121777   !!---------------------------------------------------------------------- 
     
    19412006      ! 
    19422007      INTEGER :: ji, jj, jn, ni, nj 
    1943       INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1944       !                                                        ! represents the bottom-left corner of cell (i,j) 
     2008      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     2009      !                                                 ! represents the bottom-left corner of cell (i,j) 
    19452010      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    19462011      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
     
    20512116      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    20522117      ! 
    2053       CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    2054 !      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2118!      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2119      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    20552120      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    20562121      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    20572122      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    20582123         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    2059       CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    2060       CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     2124      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    20612125      ! 
    20622126      CALL iom_update_file_name('ptr') 
     
    21132177      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    21142178      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
    2115       f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
    2116       f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     2179      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of) 
    21172180 
    21182181      ! output file names (attribut: name) 
     
    22392302      CHARACTER(LEN=20)  ::   clfreq 
    22402303      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 
    22432304      INTEGER            ::   idx 
    22442305      INTEGER            ::   jn 
     
    22972358            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    22982359            DO WHILE ( idx /= 0 )  
    2299                cldate = iom_sdate( fjulday - rdt / rday ) 
     2360               cldate = iom_sdate( fjulday - rn_Dt / rday ) 
    23002361               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 
    23012362               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
     
    23042365            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    23052366            DO WHILE ( idx /= 0 )  
    2306                cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 
     2367               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 
    23072368               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 
    23082369               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
     
    23112372            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    23122373            DO WHILE ( idx /= 0 )  
    2313                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
     2374               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
    23142375               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 
    23152376               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
     
    23182379            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    23192380            DO WHILE ( idx /= 0 )  
    2320                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
     2381               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
    23212382               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 
    23222383               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    23232384            END DO 
    23242385            ! 
    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  
     2386            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    23342387            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    23352388            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
     
    24102463   END SUBROUTINE iom_context_finalize 
    24112464 
     2465   SUBROUTINE iom_update_file_name( cdid ) 
     2466      CHARACTER(LEN=*), INTENT(in) ::   cdid 
     2467      IF( .FALSE. )   WRITE(numout,*)  cdid   ! useless test to avoid compilation warnings 
     2468   END SUBROUTINE iom_update_file_name 
     2469 
    24122470#endif 
    24132471 
     
    24292487#else 
    24302488      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
     2489      IF( .FALSE. )   pmiss_val = 0._wp                   ! useless assignment to avoid compilation warnings 
    24312490#endif 
    24322491   END SUBROUTINE iom_miss_val 
Note: See TracChangeset for help on using the changeset viewer.