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 10358 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/BENCH/MY_SRC/diawri.F90 – NEMO

Ignore:
Timestamp:
2018-11-25T15:24:21+01:00 (5 years ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 5b: by default, suppress global communication in stpctl, see #2133

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/BENCH/MY_SRC/diawri.F90

    r10179 r10358  
    5252 
    5353#if defined key_si3 
     54   USE ice 
    5455   USE icewri  
    5556#endif 
     
    119120      ! Output the initial state and forcings 
    120121      IF( ninist == 1 ) THEN                        
    121          CALL dia_wri_state( 'output.init', kt ) 
     122         CALL dia_wri_state( 'output.init' ) 
    122123         ninist = 0 
    123124      ENDIF 
     
    410411 
    411412      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    412          CALL dia_wri_state( 'output.init', kt ) 
     413         CALL dia_wri_state( 'output.init' ) 
    413414         ninist = 0 
    414415      ENDIF 
     
    418419#endif 
    419420 
    420    SUBROUTINE dia_wri_state( cdfile_name, kt ) 
     421   SUBROUTINE dia_wri_state( cdfile_name ) 
    421422      !!--------------------------------------------------------------------- 
    422423      !!                 ***  ROUTINE dia_wri_state  *** 
     
    432433      !!---------------------------------------------------------------------- 
    433434      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    434       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    435       !!  
    436       CHARACTER (len=32) :: clname 
    437       CHARACTER (len=40) :: clop 
    438       INTEGER  ::   id_i , nz_i, nh_i        
    439       INTEGER, DIMENSION(1) ::   idex             ! local workspace 
    440       REAL(wp) ::   zsto, zout, zmax, zjulian 
     435      !! 
     436      INTEGER :: inum 
    441437      !!---------------------------------------------------------------------- 
    442438      !  
    443       ! 0. Initialisation 
    444       ! ----------------- 
    445  
    446       ! Define name, frequency of output and means 
    447       clname = cdfile_name 
    448       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    449       zsto = rdt 
    450       clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    451       zout = rdt 
    452       zmax = ( nitend - nit000 + 1 ) * rdt 
    453  
    454439      IF(lwp) WRITE(numout,*) 
    455440      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    456441      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    457       IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc' 
    458  
    459  
    460       ! 1. Define NETCDF files and fields at beginning of first time step 
    461       ! ----------------------------------------------------------------- 
    462  
    463       ! Compute julian date from starting date of the run 
    464       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
    465       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    466       CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    467           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    468       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    469           "m", jpk, gdept_1d, nz_i, "down") 
    470  
    471       ! Declare all the output fields as NetCDF variables 
    472  
    473       CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity 
    474          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    475       CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature 
    476          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    477       CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh 
    478          &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout ) 
    479       CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current 
    480          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    481       CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current 
    482          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    483       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    484          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    485          ! 
     442      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
     443 
     444#if defined key_si3 
     445     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 
     446#else 
     447     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     448#endif 
     449 
     450      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
     451      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
     452      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
     453      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
     454      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     455      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    486456      IF( ALLOCATED(ahtu) ) THEN 
    487          CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
    488             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    489          CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
    490             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    491       ENDIF 
    492       IF( ALLOCATED(ahmt) ) THEN  
    493          CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
    494             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    495          CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
    496             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    497       ENDIF 
    498          ! 
    499       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    500          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    501       CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    502          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    503       CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux 
    504          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    505       CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i 
    506          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    507       CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress 
    508          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    509       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    510          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    511       IF( .NOT.ln_linssh ) THEN 
    512          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth 
    513             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    514          CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth 
    515             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    516       ENDIF 
    517       ! 
     457         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
     458         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point 
     459      ENDIF 
     460      IF( ALLOCATED(ahmt) ) THEN 
     461         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point 
     462         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point 
     463      ENDIF 
     464      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
     465      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
     466      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
     467      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
     468      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
     469      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     470      IF(  .NOT.ln_linssh  ) THEN              
     471         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
     472         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     473      END IF 
    518474      IF( ln_wave .AND. ln_sdw ) THEN 
    519          CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current 
    520             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    521          CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current 
    522             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    523          CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current 
    524             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    525       ENDIF 
    526  
     475         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity 
     476         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity 
     477         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
     478      ENDIF 
     479  
    527480#if defined key_si3 
    528481      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
    529          CALL ice_wri_state( kt, id_i, nh_i ) 
    530       ENDIF 
    531 #else 
    532       CALL histend( id_i, snc4chunks=snc4set ) 
     482         CALL ice_wri_state( inum ) 
     483      ENDIF 
    533484#endif 
    534  
    535       ! 2. Start writing data 
    536       ! --------------------- 
    537       ! idex(1) est utilise ssi l'avant dernier argument est diffferent de  
    538       ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    539       ! donne le nombre d'elements, et idex la liste des indices a sortir 
    540       idex(1) = 1   ! init to avoid compil warning 
    541  
    542       ! Write all fields on T grid 
    543       CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
    544       CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
    545       CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
    546       CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
    547       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    548       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    549       ! 
    550       IF( ALLOCATED(ahtu) ) THEN 
    551          CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
    552          CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
    553       ENDIF 
    554       IF( ALLOCATED(ahmt) ) THEN 
    555          CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
    556          CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
    557       ENDIF 
    558       ! 
    559       CALL histwrite( id_i, "sowaflup", kt, emp - rnf        , jpi*jpj    , idex )    ! freshwater budget 
    560       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    561       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    562       CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
    563       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    564       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    565  
    566       IF(  .NOT.ln_linssh  ) THEN              
    567          CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth  
    568          CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness   
    569       END IF  
    570   
    571       IF( ln_wave .AND. ln_sdw ) THEN 
    572          CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity 
    573          CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity 
    574          CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity 
    575       ENDIF 
    576  
    577       ! 3. Close the file 
    578       ! ----------------- 
    579       CALL histclo( id_i ) 
    580 #if ! defined key_iomput 
    581       IF( ninist /= 1  ) THEN 
    582          CALL histclo( nid_T ) 
    583          CALL histclo( nid_U ) 
    584          CALL histclo( nid_V ) 
    585          CALL histclo( nid_W ) 
    586       ENDIF 
    587 #endif 
     485      ! 
     486      CALL iom_close( inum ) 
    588487      !  
    589488   END SUBROUTINE dia_wri_state 
Note: See TracChangeset for help on using the changeset viewer.