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 8850 for branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2017-11-30T09:30:44+01:00 (6 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): PART I.3 - phasing with trunk: tracer trends output (see #1877 trunk change from 86666 to 8698)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8817 r8850  
    205205      ! end file definition 
    206206      dtime%second = rdt 
    207       CALL xios_set_timestep(dtime) 
     207      CALL xios_set_timestep( dtime ) 
    208208      CALL xios_close_context_definition() 
    209        
    210       CALL xios_update_calendar(0) 
     209      CALL xios_update_calendar( 0 ) 
    211210      ! 
    212211      DEALLOCATE( zt_bnds, zw_bnds ) 
     
    253252      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    254253      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
    255  
     254      ! 
    256255      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    257256      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode) 
     
    645644      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    646645      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
    647                                                                            ! look for and use a file attribute 
    648                                                                            ! called open_ocean_jstart to set the start 
    649                                                                            ! value for the 2nd dimension (netcdf only) 
     646      !                                                                    ! look for and use a file attribute 
     647      !                                                                    ! called open_ocean_jstart to set the start 
     648      !                                                                    ! value for the 2nd dimension (netcdf only) 
    650649      ! 
    651650      LOGICAL                        ::   llnoov      ! local definition to read overlap 
     
    780779         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
    781780            istart(1:idmspc) = kstart(1:idmspc)  
    782             icnt(1:idmspc) = kcount(1:idmspc) 
     781            icnt  (1:idmspc) = kcount(1:idmspc) 
    783782         ELSE 
    784783            IF(idom == jpdom_unknown ) THEN 
     
    806805                  ENDIF 
    807806                  IF( PRESENT(pv_r3d) ) THEN 
    808                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = inlev 
    809                      ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    810                      ELSE                                                           ; icnt(3) = inlev 
     807                     IF( idom == jpdom_data ) THEN                        ;                              icnt(3) = inlev 
     808                     ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;  icnt(3) = kcount(3) 
     809                     ELSE                                                 ;                              icnt(3) = inlev 
    811810                     ENDIF 
    812811                  ENDIF 
     
    12511250 
    12521251#if defined key_iomput 
    1253  
    12541252   !!---------------------------------------------------------------------- 
    12551253   !!   'key_iomput'                                         IOM  interface 
     
    14131411      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    14141412      ! 
    1415       INTEGER  :: ni,nj 
     1413      INTEGER  :: ni, nj 
    14161414      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    14171415      !!---------------------------------------------------------------------- 
    14181416      ! 
    1419       ni=nlei-nldi+1 ; nj=nlej-nldj+1 
     1417      ni = nlei-nldi+1 
     1418      nj = nlej-nldj+1 
    14201419      ! 
    14211420      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     
    14681467      END SELECT 
    14691468      ! 
    1470       ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
     1469      ni = nlei-nldi+1   ! Dimensions of subdomain interior 
     1470      nj = nlej-nldj+1 
    14711471      ! 
    14721472      z_fld(:,:) = 1._wp 
     
    15531553      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    15541554      ! 
     1555      INTEGER  :: ni, nj, ix, iy 
    15551556      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    1556       INTEGER  :: ni,nj, ix, iy 
    1557       !!---------------------------------------------------------------------- 
    1558       ! 
    1559       ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk) 
    1560       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
     1557      !!---------------------------------------------------------------------- 
     1558      ! 
     1559      ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
     1560      nj=nlej-nldj+1 
     1561      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    15611562      ! 
    15621563      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     
    16161617      !  
    16171618      ! frequency of the call of iom_put (attribut: freq_op) 
    1618       f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
    1619       f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    1620       f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
    1621       f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
    1622       f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     1619      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
     1620      f_op%timestep = 2        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('trendT_even'     , freq_op=f_op, freq_offset=f_of) 
     1621      f_op%timestep = 2        ;  f_of%timestep = -1  ; CALL iom_set_field_attr('trendT_odd'      , freq_op=f_op, freq_offset=f_of) 
     1622      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
     1623      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
     1624      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
     1625      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
    16231626 
    16241627      ! output file names (attribut: name) 
     
    17531756      TYPE(xios_duration)   ::   output_freq  
    17541757      !!---------------------------------------------------------------------- 
    1755  
    1756       DO jn = 1,2 
    1757  
     1758      ! 
     1759      DO jn = 1, 2 
     1760         ! 
    17581761         output_freq = xios_duration(0,0,0,0,0,0) 
    17591762         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq ) 
    17601763         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    1761  
     1764         ! 
    17621765         IF ( TRIM(clname) /= '' ) THEN  
    1763  
     1766            ! 
    17641767            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    17651768            DO WHILE ( idx /= 0 )  
     
    17671770               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    17681771            END DO 
    1769  
     1772            ! 
    17701773            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    17711774            DO WHILE ( idx /= 0 )  
     
    17981801              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    17991802            END DO 
    1800  
     1803            ! 
    18011804            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    18021805            DO WHILE ( idx /= 0 )  
     
    18051808               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    18061809            END DO 
    1807  
     1810            ! 
    18081811            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    18091812            DO WHILE ( idx /= 0 )  
     
    18121815               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    18131816            END DO 
    1814  
     1817            ! 
    18151818            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    18161819            DO WHILE ( idx /= 0 )  
     
    18441847      !! ** Purpose :   send back the date corresponding to the given julian day 
    18451848      !!---------------------------------------------------------------------- 
    1846       REAL(wp), INTENT(in   )           ::   pjday         ! julian day 
    1847       LOGICAL , INTENT(in   ), OPTIONAL ::   ld24          ! true to force 24:00 instead of 00:00 
    1848       LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull        ! true to get the compleate date: yyyymmdd_hh:mm:ss 
     1849      REAL(wp), INTENT(in   )           ::   pjday    ! julian day 
     1850      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24     ! true to force 24:00 instead of 00:00 
     1851      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull   ! true to get the compleate date: yyyymmdd_hh:mm:ss 
    18491852      ! 
    18501853      CHARACTER(LEN=20) ::   iom_sdate 
     
    18921895 
    18931896#else 
     1897   !!---------------------------------------------------------------------- 
     1898   !!   NOT 'key_iomput'                               a few dummy routines 
     1899   !!---------------------------------------------------------------------- 
    18941900 
    18951901   SUBROUTINE iom_setkt( kt, cdname ) 
     
    19071913 
    19081914   LOGICAL FUNCTION iom_use( cdname ) 
     1915      !!---------------------------------------------------------------------- 
     1916      !!---------------------------------------------------------------------- 
    19091917      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     1918      !!---------------------------------------------------------------------- 
    19101919#if defined key_iomput 
    19111920      iom_use = xios_field_is_active( cdname ) 
Note: See TracChangeset for help on using the changeset viewer.