Changeset 10358


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

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

Location:
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/iceistate.F90

    r10292 r10358  
    477477!!clem: output of initial state should be written here but it is impossible because 
    478478!!      the ocean and ice are in the same file 
    479 !!      CALL dia_wri_state( 'output.init', nit000 ) 
     479!!      CALL dia_wri_state( 'output.init' ) 
    480480      ! 
    481481   END SUBROUTINE ice_istate 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icewri.F90

    r10314 r10358  
    227227 
    228228  
    229    SUBROUTINE ice_wri_state( kt, kid, kh_i ) 
     229   SUBROUTINE ice_wri_state( kid ) 
    230230      !!--------------------------------------------------------------------- 
    231231      !!                 ***  ROUTINE ice_wri_state  *** 
     
    238238      !! History :   4.0  !  2013-06  (C. Rousset) 
    239239      !!---------------------------------------------------------------------- 
    240       INTEGER, INTENT( in ) ::   kt               ! ocean time-step index 
    241       INTEGER, INTENT( in ) ::   kid , kh_i 
    242       INTEGER               ::   nz_i, jl 
    243       REAL(wp), DIMENSION(jpl) ::   jcat 
     240      INTEGER, INTENT( in ) ::   kid  
    244241      !!---------------------------------------------------------------------- 
    245242      ! 
    246       DO jl = 1, jpl 
    247          jcat(jl) = REAL(jl) 
    248       END DO 
    249        
    250       CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 
    251  
    252       CALL histdef( kid, "sithic", "Ice thickness"          , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    253       CALL histdef( kid, "siconc", "Ice concentration"      , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    254       CALL histdef( kid, "sitemp", "Ice temperature"        , "C"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    255       CALL histdef( kid, "sivelu", "i-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    256       CALL histdef( kid, "sivelv", "j-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    257       CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    258       CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    259       CALL histdef( kid, "sisflx", "Solar flx over ocean"   , "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    260       CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    261       CALL histdef( kid, "snwpre", "Snow precipitation"     , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    262       CALL histdef( kid, "sisali", "Ice salinity"           , "PSU"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    263       CALL histdef( kid, "sivolu", "Ice volume"             , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    264       CALL histdef( kid, "sidive", "Ice divergence"         , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    265       CALL histdef( kid, "si_amp", "Melt pond fraction"     , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    266       CALL histdef( kid, "si_vmp", "Melt pond volume"       ,  "m"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    267       ! 
    268       CALL histdef( kid, "sithicat", "Ice thickness"        , "m"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    269       CALL histdef( kid, "siconcat", "Ice concentration"    , "%"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    270       CALL histdef( kid, "sisalcat", "Ice salinity"         , ""       , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    271       CALL histdef( kid, "snthicat", "Snw thickness"        , "m"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    272  
    273       CALL histend( kid, snc4set )   ! end of the file definition 
    274  
    275       CALL histwrite( kid, "sithic", kt, hm_i          , jpi*jpj, (/1/) )     
    276       CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) ) 
    277       CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
    278       CALL histwrite( kid, "sivelu", kt, u_ice         , jpi*jpj, (/1/) ) 
    279       CALL histwrite( kid, "sivelv", kt, v_ice         , jpi*jpj, (/1/) ) 
    280       CALL histwrite( kid, "sistru", kt, utau_ice      , jpi*jpj, (/1/) ) 
    281       CALL histwrite( kid, "sistrv", kt, vtau_ice      , jpi*jpj, (/1/) ) 
    282       CALL histwrite( kid, "sisflx", kt, qsr           , jpi*jpj, (/1/) ) 
    283       CALL histwrite( kid, "sinflx", kt, qns           , jpi*jpj, (/1/) ) 
    284       CALL histwrite( kid, "snwpre", kt, sprecip       , jpi*jpj, (/1/) ) 
    285       CALL histwrite( kid, "sisali", kt, sm_i          , jpi*jpj, (/1/) ) 
    286       CALL histwrite( kid, "sivolu", kt, vt_i          , jpi*jpj, (/1/) ) 
    287       CALL histwrite( kid, "sidive", kt, divu_i*1.0e8  , jpi*jpj, (/1/) ) 
    288       CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) ) 
    289       CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) ) 
    290       ! 
    291       CALL histwrite( kid, "sithicat", kt, h_i         , jpi*jpj*jpl, (/1/) )     
    292       CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )     
    293       CALL histwrite( kid, "sisalcat", kt, s_i         , jpi*jpj*jpl, (/1/) )     
    294       CALL histwrite( kid, "snthicat", kt, h_s         , jpi*jpj*jpl, (/1/) )     
    295  
    296       !! The file is closed in dia_wri_state (ocean routine) 
    297       !! CALL histclo( kid ) 
    298       ! 
     243      !! The file is open in dia_wri_state (ocean routine) 
     244 
     245      CALL iom_rstput( 0, 0, kid, 'sithic', hm_i         )   ! Ice thickness 
     246      CALL iom_rstput( 0, 0, kid, 'siconc', at_i         )   ! Ice concentration 
     247      CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i - rt0   )   ! Ice temperature 
     248      CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice        )   ! i-Ice speed 
     249      CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice        )   ! j-Ice speed 
     250      CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice     )   ! i-Wind stress over ice 
     251      CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice     )   ! i-Wind stress over ice 
     252      CALL iom_rstput( 0, 0, kid, 'sisflx', qsr          )   ! Solar flx over ocean 
     253      CALL iom_rstput( 0, 0, kid, 'sinflx', qns          )   ! NonSolar flx over ocean 
     254      CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip      )   ! Snow precipitation 
     255      CALL iom_rstput( 0, 0, kid, 'sisali', sm_i         )   ! Ice salinity 
     256      CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i         )   ! Ice volume 
     257      CALL iom_rstput( 0, 0, kid, 'sidive', divu_i*1.0e8 )   ! Ice divergence 
     258      CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip        )   ! Melt pond fraction 
     259      CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip        )   ! Melt pond volume 
     260      CALL iom_rstput( 0, 0, kid, 'sithicat', h_i        )   ! Ice thickness 
     261      CALL iom_rstput( 0, 0, kid, 'siconcat', a_i        )   ! Ice concentration 
     262      CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i        )   ! Ice salinity 
     263      CALL iom_rstput( 0, 0, kid, 'snthicat', h_s        )   ! Snw thickness 
     264 
    299265    END SUBROUTINE ice_wri_state 
    300266 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DIA/diawri.F90

    r10297 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 
     
    445446      ! 
    446447      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    447          CALL dia_wri_state( 'output.init', kt ) 
     448         CALL dia_wri_state( 'output.init' ) 
    448449         ninist = 0 
    449450      ENDIF 
     
    868869#endif 
    869870 
    870    SUBROUTINE dia_wri_state( cdfile_name, kt ) 
     871   SUBROUTINE dia_wri_state( cdfile_name ) 
    871872      !!--------------------------------------------------------------------- 
    872873      !!                 ***  ROUTINE dia_wri_state  *** 
     
    882883      !!---------------------------------------------------------------------- 
    883884      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    884       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    885       !!  
    886       CHARACTER (len=32) :: clname 
    887       CHARACTER (len=40) :: clop 
    888       INTEGER  ::   id_i , nz_i, nh_i        
    889       INTEGER, DIMENSION(1) ::   idex             ! local workspace 
    890       REAL(wp) ::   zsto, zout, zmax, zjulian 
     885      !! 
     886      INTEGER :: inum 
    891887      !!---------------------------------------------------------------------- 
    892888      !  
    893       ! 0. Initialisation 
    894       ! ----------------- 
    895  
    896       ! Define name, frequency of output and means 
    897       clname = cdfile_name 
    898       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    899       zsto = rdt 
    900       clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    901       zout = rdt 
    902       zmax = ( nitend - nit000 + 1 ) * rdt 
    903  
    904889      IF(lwp) WRITE(numout,*) 
    905890      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    906891      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    907       IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc' 
    908  
    909  
    910       ! 1. Define NETCDF files and fields at beginning of first time step 
    911       ! ----------------------------------------------------------------- 
    912  
    913       ! Compute julian date from starting date of the run 
    914       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
    915       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    916       CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    917           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    918       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    919           "m", jpk, gdept_1d, nz_i, "down") 
    920  
    921       ! Declare all the output fields as NetCDF variables 
    922  
    923       CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity 
    924          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    925       CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature 
    926          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    927       CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh 
    928          &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout ) 
    929       CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current 
    930          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    931       CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current 
    932          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    933       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    934          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    935          ! 
     892      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
     893 
     894#if defined key_si3 
     895     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 
     896#else 
     897     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     898#endif 
     899 
     900      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
     901      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
     902      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
     903      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
     904      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     905      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    936906      IF( ALLOCATED(ahtu) ) THEN 
    937          CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
    938             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    939          CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
    940             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    941       ENDIF 
    942       IF( ALLOCATED(ahmt) ) THEN  
    943          CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
    944             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    945          CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
    946             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    947       ENDIF 
    948          ! 
    949       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    950          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    951       CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    952          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    953       CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux 
    954          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    955       CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i 
    956          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    957       CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress 
    958          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    959       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    960          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    961       IF( .NOT.ln_linssh ) THEN 
    962          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth 
    963             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    964          CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth 
    965             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    966       ENDIF 
    967       ! 
     907         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
     908         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point 
     909      ENDIF 
     910      IF( ALLOCATED(ahmt) ) THEN 
     911         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point 
     912         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point 
     913      ENDIF 
     914      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
     915      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
     916      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
     917      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
     918      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
     919      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     920      IF(  .NOT.ln_linssh  ) THEN              
     921         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
     922         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     923      END IF 
    968924      IF( ln_wave .AND. ln_sdw ) THEN 
    969          CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current 
    970             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    971          CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current 
    972             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    973          CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current 
    974             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    975       ENDIF 
    976  
     925         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity 
     926         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity 
     927         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
     928      ENDIF 
     929  
    977930#if defined key_si3 
    978931      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
    979          CALL ice_wri_state( kt, id_i, nh_i ) 
    980       ENDIF 
    981 #else 
    982       CALL histend( id_i, snc4chunks=snc4set ) 
     932         CALL ice_wri_state( inum ) 
     933      ENDIF 
    983934#endif 
    984  
    985       ! 2. Start writing data 
    986       ! --------------------- 
    987       ! idex(1) est utilise ssi l'avant dernier argument est diffferent de  
    988       ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    989       ! donne le nombre d'elements, et idex la liste des indices a sortir 
    990       idex(1) = 1   ! init to avoid compil warning 
    991  
    992       ! Write all fields on T grid 
    993       CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
    994       CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
    995       CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
    996       CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
    997       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    998       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    999       ! 
    1000       IF( ALLOCATED(ahtu) ) THEN 
    1001          CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
    1002          CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
    1003       ENDIF 
    1004       IF( ALLOCATED(ahmt) ) THEN 
    1005          CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
    1006          CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
    1007       ENDIF 
    1008       ! 
    1009       CALL histwrite( id_i, "sowaflup", kt, emp - rnf        , jpi*jpj    , idex )    ! freshwater budget 
    1010       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1011       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    1012       CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
    1013       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    1014       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    1015  
    1016       IF(  .NOT.ln_linssh  ) THEN              
    1017          CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth  
    1018          CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness   
    1019       END IF  
    1020   
    1021       IF( ln_wave .AND. ln_sdw ) THEN 
    1022          CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity 
    1023          CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity 
    1024          CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity 
    1025       ENDIF 
    1026  
    1027       ! 3. Close the file 
    1028       ! ----------------- 
    1029       CALL histclo( id_i ) 
    1030 #if ! defined key_iomput 
    1031       IF( ninist /= 1  ) THEN 
    1032          CALL histclo( nid_T ) 
    1033          CALL histclo( nid_U ) 
    1034          CALL histclo( nid_V ) 
    1035          CALL histclo( nid_W ) 
    1036       ENDIF 
    1037 #endif 
     935      ! 
     936      CALL iom_close( inum ) 
    1038937      !  
    1039938   END SUBROUTINE dia_wri_state 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/iom_nf90.F90

    r10068 r10358  
    129129               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo) 
    130130            ENDIF 
    131             CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                    ), clinfo) 
     131            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    132132            ! define dimensions 
    133             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x'      , kdompar(1,1)  , idmy ), clinfo) 
    134             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y'      , kdompar(2,1)  , idmy ), clinfo) 
    135             IF( PRESENT(kdlev) ) THEN 
    136                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat' , ilevels    , idmy ), clinfo) 
    137             ELSE 
    138                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', ilevels    , idmy ), clinfo) 
    139             ENDIF 
     133            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
     134            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     135            CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    140136            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     137            IF( PRESENT(kdlev) )   & 
     138               CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo) 
    141139            ! global attributes 
    142140            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
     
    704702      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
    705703      INTEGER               :: idlv                 ! local variable 
     704      INTEGER               :: idim3                ! id of the third dimension 
    706705      !--------------------------------------------------------------------- 
    707706      ! 
     
    752751         ! variable definition 
    753752         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    754          ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/) 
     753         ELSEIF( PRESENT(pv_r1d) ) THEN 
     754            IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3 
     755            ELSE                               ;   idim3 = 5 
     756            ENDIF 
     757                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    755758         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
    756          ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/) 
     759         ELSEIF( PRESENT(pv_r3d) ) THEN 
     760            IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3 
     761            ELSE                               ;   idim3 = 5 
     762            ENDIF 
     763                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
    757764         ENDIF 
    758765         IF( PRESENT(ktype) ) THEN   ! variable external type 
    759766            SELECT CASE (ktype) 
    760             CASE (jp_r8)  ;   itype = NF90_DOUBLE 
    761             CASE (jp_r4)  ;   itype = NF90_FLOAT 
    762             CASE (jp_i4)  ;   itype = NF90_INT 
    763             CASE (jp_i2)  ;   itype = NF90_SHORT 
    764             CASE (jp_i1)  ;   itype = NF90_BYTE 
     767            CASE (jp_r8)   ;   itype = NF90_DOUBLE 
     768            CASE (jp_r4)   ;   itype = NF90_FLOAT 
     769            CASE (jp_i4)   ;   itype = NF90_INT 
     770            CASE (jp_i2)   ;   itype = NF90_SHORT 
     771            CASE (jp_i1)   ;   itype = NF90_BYTE 
    765772            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' ) 
    766773            END SELECT 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90

    r10357 r10358  
    574574      INTEGER, INTENT(in   ), OPTIONAL     ::   kcom  
    575575      INTEGER  ::   ierror, ilocalcomm 
    576       LOGICAL, SAVE ::   ll_switch  
     576      LOGICAL, SAVE ::   ll_switch , lllast 
    577577      INTEGER, SAVE ::   ireq = -1 
    578578      !!---------------------------------------------------------------------- 
    579579      ilocalcomm = mpi_comm_oce 
    580       IF( PRESENT(kcom) )   ilocalcomm = kcom 
     580      IF( PRESENT(  kcom) )   ilocalcomm = kcom 
     581      lllast = .FALSE. 
     582      IF( PRESENT(ldlast) )   lllast = ldlast 
    581583       
    582584      IF ( ireq /= -1 ) THEN   ! get ld_switch(2) from ll_switch (from previous call) 
     
    586588         IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    587589      ENDIF 
    588       IF( .NOT. ldlast ) &     ! send ll_switch to be received on next call 
     590      IF( .NOT. lllast ) &     ! send ll_switch to be received on next call 
    589591         CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 
    590592 
     
    751753 
    752754 
    753    SUBROUTINE mppstop( ldfinal )  
     755   SUBROUTINE mppstop( ldfinal, ld_force_abort )  
    754756      !!---------------------------------------------------------------------- 
    755757      !!                  ***  routine mppstop  *** 
     
    759761      !!---------------------------------------------------------------------- 
    760762      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number 
    761       LOGICAL ::   llfinal 
     763      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number 
     764      LOGICAL ::   llfinal, ll_force_abort 
    762765      INTEGER ::   info 
    763766      !!---------------------------------------------------------------------- 
    764       ! 
    765       CALL mppsync 
    766       CALL mpi_finalize( info ) 
    767767      llfinal = .FALSE. 
    768768      IF( PRESENT(ldfinal) ) llfinal = ldfinal 
     769      ll_force_abort = .FALSE. 
     770      IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort 
     771      ! 
     772      IF(ll_force_abort) THEN 
     773         CALL mpi_abort( MPI_COMM_WORLD ) 
     774      ELSE 
     775         CALL mppsync 
     776         CALL mpi_finalize( info ) 
     777      ENDIF 
    769778      IF( .NOT. llfinal ) STOP 123456 
    770779      ! 
     
    16381647   END SUBROUTINE mpp_ilor 
    16391648 
    1640    SUBROUTINE mppstop 
     1649   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
     1650      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number 
     1651      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number 
    16411652      STOP      ! non MPP case, just stop the run 
    16421653   END SUBROUTINE mppstop 
     
    17661777      iost=0 
    17671778      IF( cdacce(1:6) == 'DIRECT' )  THEN 
    1768          OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost ) 
     1779         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh         , ERR=100, IOSTAT=iost ) 
     1780      ELSE IF( cdstat(1:6) == 'APPEND' )  THEN 
     1781         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS='UNKNOWN', POSITION='APPEND', ERR=100, IOSTAT=iost ) 
    17691782      ELSE 
    1770          OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost ) 
    1771       ENDIF 
    1772       IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) & 
    1773          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )   ! for windows 
     1783         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost ) 
     1784      ENDIF 
     1785      IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows 
     1786         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )    
    17741787      IF( iost == 0 ) THEN 
    17751788         IF(ldwp) THEN 
    1776             WRITE(kout,*) '     file   : ', clfile,' open ok' 
     1789            WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok' 
    17771790            WRITE(kout,*) '     unit   = ', knum 
    17781791            WRITE(kout,*) '     status = ', cdstat 
     
    17861799         IF(ldwp) THEN 
    17871800            WRITE(kout,*) 
    1788             WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile 
     1801            WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 
    17891802            WRITE(kout,*) ' =======   ===  ' 
    17901803            WRITE(kout,*) '           unit   = ', knum 
     
    17971810         ELSE  !!! Force writing to make sure we get the information - at least once - in this violent STOP!! 
    17981811            WRITE(*,*) 
    1799             WRITE(*,*) ' ===>>>> : bad opening file: ', clfile 
     1812            WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 
    18001813            WRITE(*,*) ' =======   ===  ' 
    18011814            WRITE(*,*) '           unit   = ', knum 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/stpctl.F90

    r10314 r10358  
    3333 
    3434   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, istatus 
     35   LOGICAL  ::   lsomeoce 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6061      INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    6162      !! 
    62       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    63       INTEGER  ::   ih(2)                  ! local integers 
    64       INTEGER  ::   iu(3)                  !   -       - 
    65       INTEGER  ::   is1(3)                 !   -       - 
    66       INTEGER  ::   is2(3)                 !   -       - 
    67       REAL(wp) ::   zzz                    ! local real  
    68       INTEGER , DIMENSION(3) ::   ilocu, ilocs1, ilocs2 
    69       INTEGER , DIMENSION(2) ::   iloch 
     63      INTEGER                ::   ji, jj, jk          ! dummy loop indices 
     64      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
     65      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
     66      REAL(wp)               ::   zzz                 ! local real  
    7067      REAL(wp), DIMENSION(5) ::   zmax 
    7168      CHARACTER(len=20) :: clname 
     
    7774         WRITE(numout,*) '~~~~~~~' 
    7875         !                                ! open time.step file 
    79          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     76         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    8077         !                                ! open run.stat file 
    81          CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    82  
    83          IF( lwm ) THEN 
     78         IF( ln_ctl .AND. lwm ) THEN 
     79            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    8480            clname = 'run.stat.nc' 
    8581            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     
    9288            istatus = NF90_ENDDEF(idrun) 
    9389         ENDIF 
    94           
    9590      ENDIF 
     91      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    9692      ! 
    97       IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     93      IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file) 
    9894         WRITE ( numstp, '(1x, i8)' )   kt 
    9995         REWIND( numstp ) 
     
    111107      zmax(5) = REAL( nstop , wp )                                            ! stop indicator 
    112108      ! 
    113       IF( lk_mpp ) THEN 
    114          CALL mpp_max( "stpctl", zmax )    ! max over the global domain 
    115          ! 
     109      IF( lk_mpp .AND. ln_ctl ) THEN 
     110         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    116111         nstop = NINT( zmax(5) )                 ! nstop indicator sheared among all local domains 
    117112      ENDIF 
    118       ! 
    119       IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
    120          WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2),   & 
    121             &                                     ' S min: '    , - zmax(3), ' S max: ', zmax(4) 
    122       ENDIF 
    123       ! 
    124       IF (  zmax(1) >   15._wp .OR.   &                    ! too large sea surface height ( > 15 m ) 
    125          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    126          &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
    127          &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    128          &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    129          &  ISNAN( zmax(1) + zmax(2) + zmax(3) )  ) THEN   ! NaN encounter in the tests 
    130          IF( lk_mpp ) THEN 
    131             CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
    132             CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  ) 
    133             CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 
    134             CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 
    135          ELSE 
    136             iloch  = MINLOC( ABS( sshn(:,:)   )                               ) 
    137             ilocu  = MAXLOC( ABS( un  (:,:,:) )                               ) 
    138             ilocs1 = MINLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 
    139             ilocs2 = MAXLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 
    140             ih(1)  = iloch (1) + nimpp - 1   ;   ih(2)  = iloch (2) + njmpp - 1 
    141             iu(1)  = ilocu (1) + nimpp - 1   ;   iu(2)  = ilocu (2) + njmpp - 1   ;   iu(3)  = ilocu (3) 
    142             is1(1) = ilocs1(1) + nimpp - 1   ;   is1(2) = ilocs1(2) + njmpp - 1   ;   is1(3) = ilocs1(3) 
    143             is2(1) = ilocs2(1) + nimpp - 1   ;   is2(2) = ilocs2(2) + njmpp - 1   ;   is2(3) = ilocs2(3) 
    144          ENDIF 
    145          IF(lwp) THEN 
    146             WRITE(numout,cform_err) 
    147             WRITE(numout,*) ' stp_ctl: |ssh| > 10 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    148             WRITE(numout,*) ' ======= ' 
    149             WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2) 
    150             WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    151             WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    152             WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    153             WRITE(numout,*) 
    154             WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
    155          ENDIF 
    156          kindic = -3 
    157          ! 
    158          nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
    159          CALL dia_wri_state( 'output.abort', kt )     ! create an output.abort file 
    160          ! 
    161       ENDIF 
    162 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    163 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    164 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
    165 9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
    166       ! 
    167       !                                            !==  run statistics  ==!   ("run.stat" file) 
    168       IF(lwp) WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    169       IF( lwm ) THEN 
     113      !                                   !==  run statistics  ==!   ("run.stat" files) 
     114      IF( ln_ctl .AND. lwm ) THEN 
     115         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    170116         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    171117         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
     
    175121         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    176122      END IF 
     123      !                                   !==  error handling  ==! 
     124      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 
     125         &  zmax(1) >   15._wp .OR.   &                    ! too large sea surface height ( > 15 m ) 
     126         &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
     127         &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
     128         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
     129         &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
     130         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
     131         IF( lk_mpp .AND. ln_ctl ) THEN 
     132            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
     133            CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  ) 
     134            CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 
     135            CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 
     136         ELSE 
     137            ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
     138            iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     139            is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     140            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     141         ENDIF 
     142         IF( numout == 6 )   &   ! force to open ocean.output file 
     143            CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     144 
     145         WRITE(numout,cform_err) 
     146         WRITE(numout,*) ' stp_ctl: |ssh| > 10 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     147         WRITE(numout,*) ' ======= ' 
     148         IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 
     149         WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2) 
     150         WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
     151         WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
     152         WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
     153         WRITE(numout,*) 
     154         WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
     155          
     156         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file 
     157          
     158         IF( ln_ctl ) THEN 
     159            kindic = -3 
     160            nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
     161         ELSE 
     162            CALL ctl_stop() 
     163            CALL mppstop(ld_force_abort = .true.) 
     164         ENDIF 
     165         ! 
     166      ENDIF 
    177167      ! 
     1689100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
     1699200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
     1709300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
     1719400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
    1781729500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    179173      ! 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OFF/nemogcm.F90

    r10345 r10358  
    481481      !!---------------------------------------------------------------------- 
    482482      ! 
    483       IF( kt == nit000 .AND. lwp ) THEN 
     483      IF( kt == nit000 .AND. lwm ) THEN 
    484484         WRITE(numout,*) 
    485485         WRITE(numout,*) 'stp_ctl : time-stepping control' 
     
    489489      ENDIF 
    490490      ! 
    491       IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
    492       IF(lwp) REWIND( numstp )                       ! -------------------------- 
     491      IF(lwm) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     492      IF(lwm) REWIND( numstp )                       ! -------------------------- 
    493493      ! 
    494494   END SUBROUTINE stp_ctl 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/diawri.F90

    r10297 r10358  
    3939   USE ioipsl 
    4040#if defined key_si3 
     41   USE ice 
    4142   USE icewri 
    4243#endif 
     
    9394      ! Output the initial state and forcings 
    9495      IF( ninist == 1 ) THEN 
    95          CALL dia_wri_state( 'output.init', kt ) 
     96         CALL dia_wri_state( 'output.init' ) 
    9697         ninist = 0 
    9798      ENDIF 
     
    142143      ! Output the initial state and forcings 
    143144      IF( ninist == 1 ) THEN                        
    144          CALL dia_wri_state( 'output.init', kt ) 
     145         CALL dia_wri_state( 'output.init' ) 
    145146         ninist = 0 
    146147      ENDIF 
     
    329330#endif 
    330331 
    331    SUBROUTINE dia_wri_state( cdfile_name, kt ) 
     332   SUBROUTINE dia_wri_state( cdfile_name ) 
    332333      !!--------------------------------------------------------------------- 
    333334      !!                 ***  ROUTINE dia_wri_state  *** 
     
    343344      !!---------------------------------------------------------------------- 
    344345      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    345       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    346       !!  
    347       CHARACTER (len=32) :: clname 
    348       CHARACTER (len=40) :: clop 
    349       INTEGER  ::   id_i , nz_i, nh_i        
    350       INTEGER, DIMENSION(1) ::   idex             ! local workspace 
    351       REAL(wp) ::   zsto, zout, zmax, zjulian 
     346      !! 
     347      INTEGER :: inum 
    352348      !!---------------------------------------------------------------------- 
    353349      !  
    354       IF( ln_timing )   CALL timing_start('dia_wri_state') 
    355  
    356       ! 0. Initialisation 
    357       ! ----------------- 
    358  
    359       ! Define name, frequency of output and means 
    360       clname = cdfile_name 
    361       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    362       zsto = rdt 
    363       clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    364       zout = rdt 
    365       zmax = ( nitend - nit000 + 1 ) * rdt 
    366  
    367350      IF(lwp) WRITE(numout,*) 
    368351      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    369352      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    370       IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc' 
    371  
    372  
    373       ! 1. Define NETCDF files and fields at beginning of first time step 
    374       ! ----------------------------------------------------------------- 
    375  
    376       ! Compute julian date from starting date of the run 
    377       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
    378       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    379       CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    380           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    381       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    382           "m", jpk, gdept_1d, nz_i, "down") 
    383  
    384       ! Declare all the output fields as NetCDF variables 
    385  
    386       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    387          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    388       CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    389          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    390       CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux 
    391          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    392       CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i 
    393          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    394       CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress 
    395          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    396       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    397          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     353      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    398354 
    399355#if defined key_si3 
    400       IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + lim but no-ice in child grid 
    401          CALL ice_wri_state( kt, id_i, nh_i ) 
    402       ENDIF 
     356     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 
    403357#else 
    404       CALL histend( id_i, snc4chunks=snc4set ) 
    405 #endif 
    406  
    407       ! 2. Start writing data 
    408       ! --------------------- 
    409       ! idex(1) est utilise ssi l'avant dernier argument est diffferent de  
    410       ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    411       ! donne le nombre d'elements, et idex la liste des indices a sortir 
    412       idex(1) = 1   ! init to avoid compil warning 
    413  
    414       ! Write all fields on T grid 
    415       CALL histwrite( id_i, "sowaflup", kt, emp              , jpi*jpj    , idex )    ! freshwater budget 
    416       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    417       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    418       CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
    419       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    420       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    421  
    422       ! 3. Close the file 
    423       ! ----------------- 
    424       CALL histclo( id_i ) 
    425 #if ! defined key_iomput 
    426       IF( ninist /= 1  ) THEN 
    427          CALL histclo( nid_T ) 
    428          CALL histclo( nid_U ) 
    429          CALL histclo( nid_V ) 
    430       ENDIF 
    431 #endif 
    432       ! 
    433       IF( ln_timing )   CALL timing_stop('dia_wri_state') 
     358     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     359#endif 
     360 
     361      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
     362      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
     363      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
     364      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
     365      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     366      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
     367      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
     368      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
     369      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
     370      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
     371      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
     372      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     373  
     374#if defined key_si3 
     375      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     376         CALL ice_wri_state( inum ) 
     377      ENDIF 
     378#endif 
     379      ! 
     380      CALL iom_close( inum ) 
    434381      ! 
    435382   END SUBROUTINE dia_wri_state 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/step.F90

    r10068 r10358  
    121121      IF( indic < 0  )  THEN 
    122122                             CALL ctl_stop( 'step: indic < 0' ) 
    123                              CALL dia_wri_state( 'output.abort', kstp ) 
     123                             CALL dia_wri_state( 'output.abort' ) 
    124124      ENDIF 
    125125      IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/stpctl.F90

    r10314 r10358  
    3232 
    3333   INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
     34   LOGICAL  ::   lsomeoce 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    5758      !! 
    5859      REAL(wp), DIMENSION(3) ::   zmax 
     60      CHARACTER(len=20) :: clname 
    5961      !!---------------------------------------------------------------------- 
    6062 
     
    6466         WRITE(numout,*) '~~~~~~~' 
    6567         !                                ! open time.step file 
    66          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     68         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    6769         !                                ! open run.stat file 
    68          CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    69  
    70          IF( lwm ) THEN 
     70         IF( ln_ctl .AND. lwm ) THEN 
     71            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     72            clname = 'run.stat.nc' 
     73            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    7174            istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 
    7275            istatus = NF90_DEF_DIM( idrun, 'time'     , NF90_UNLIMITED, idtime ) 
     
    7679            istatus = NF90_ENDDEF(idrun) 
    7780         ENDIF 
    78           
    7981      ENDIF 
     82      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    8083      ! 
    81       IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     84      IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file) 
    8285         WRITE ( numstp, '(1x, i8)' )   kt 
    8386         REWIND( numstp ) 
    8487      ENDIF 
    8588      !                                   !==  test of extrema  ==! 
    86       zmax(1) = MAXVAL(      vt_i (:,:) )                                           ! max ice thickness 
    87       zmax(2) = MAXVAL( ABS( u_ice(:,:) ) )                                         ! max ice velocity (zonal only) 
    88       zmax(3) = MAXVAL(     -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp )   ! min ice temperature 
    89       ! 
    90       IF( lk_mpp ) CALL mpp_max( "stpctl", zmax )    ! max over the global domain 
    91       ! 
    92       IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
    93          WRITE(numout,*) ' ==>> time-step= ', kt, ' vt_i max: ',  zmax(1), ' |u_ice| max: ', zmax(2), ' tm_i min: ', -zmax(3) 
    94       ENDIF 
    95  
     89      IF( ln_ctl ) THEN   ! must be done by all processes because of the mpp_max 
     90         zmax(1) = MAXVAL(      vt_i (:,:) )                                           ! max ice thickness 
     91         zmax(2) = MAXVAL( ABS( u_ice(:,:) ) )                                         ! max ice velocity (zonal only) 
     92         zmax(3) = MAXVAL(     -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp )   ! min ice temperature 
     93         IF( lk_mpp ) CALL mpp_max( "stpctl", zmax )                                   ! max over the global domain 
     94      END IF 
    9695      !                                            !==  run statistics  ==!   ("run.stat" file) 
    97       IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 
    98       IF( lwm ) THEN 
     96      IF( ln_ctl .AND. lwm ) THEN 
     97         IF(lwp) WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 
    9998         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    10099         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
     
    104103      END IF 
    105104      ! 
    106 9400  FORMAT(' it :', i8, '    vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 
     1059500  FORMAT(' it :', i8, '    vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 
    107106      ! 
    108107   END SUBROUTINE stp_ctl 
  • 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 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/diawri.F90

    r10297 r10358  
    5252 
    5353#if defined key_si3 
     54   USE ice  
    5455   USE icewri  
    5556#endif 
     
    8990   !!   'key_iomput'                                        use IOM library 
    9091   !!---------------------------------------------------------------------- 
    91  
    9292   INTEGER FUNCTION dia_wri_alloc() 
    9393      ! 
     
    9696   END FUNCTION dia_wri_alloc 
    9797 
    98  
     98    
    9999   SUBROUTINE dia_wri( kt ) 
    100100      !!--------------------------------------------------------------------- 
     
    123123      ! Output the initial state and forcings 
    124124      IF( ninist == 1 ) THEN                        
    125          CALL dia_wri_state( 'output.init', kt ) 
     125         CALL dia_wri_state( 'output.init' ) 
    126126         ninist = 0 
    127127      ENDIF 
     
    129129      ! Output of initial vertical scale factor 
    130130      CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
    131       CALL iom_put("e3u_0", e3t_0(:,:,:) ) 
    132       CALL iom_put("e3v_0", e3t_0(:,:,:) ) 
     131      CALL iom_put("e3u_0", e3u_0(:,:,:) ) 
     132      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
    133133      ! 
    134134      CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
     
    505505   !!   Default option                                  use IOIPSL  library 
    506506   !!---------------------------------------------------------------------- 
    507     
     507 
    508508   INTEGER FUNCTION dia_wri_alloc() 
    509509      !!---------------------------------------------------------------------- 
     
    519519      ! 
    520520   END FUNCTION dia_wri_alloc 
    521    
    522    
     521 
     522    
    523523   SUBROUTINE dia_wri( kt ) 
    524524      !!--------------------------------------------------------------------- 
     
    551551      ! 
    552552      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    553          CALL dia_wri_state( 'output.init', kt ) 
     553         CALL dia_wri_state( 'output.init' ) 
    554554         ninist = 0 
    555555      ENDIF 
     
    974974#endif 
    975975 
    976    SUBROUTINE dia_wri_state( cdfile_name, kt ) 
     976   SUBROUTINE dia_wri_state( cdfile_name ) 
    977977      !!--------------------------------------------------------------------- 
    978978      !!                 ***  ROUTINE dia_wri_state  *** 
     
    988988      !!---------------------------------------------------------------------- 
    989989      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    990       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    991       !!  
    992       CHARACTER (len=32) :: clname 
    993       CHARACTER (len=40) :: clop 
    994       INTEGER  ::   id_i , nz_i, nh_i        
    995       INTEGER, DIMENSION(1) ::   idex             ! local workspace 
    996       REAL(wp) ::   zsto, zout, zmax, zjulian 
     990      !! 
     991      INTEGER :: inum 
    997992      !!---------------------------------------------------------------------- 
    998993      !  
    999       ! 0. Initialisation 
    1000       ! ----------------- 
    1001  
    1002       ! Define name, frequency of output and means 
    1003       clname = cdfile_name 
    1004       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    1005       zsto = rdt 
    1006       clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    1007       zout = rdt 
    1008       zmax = ( nitend - nit000 + 1 ) * rdt 
    1009  
    1010994      IF(lwp) WRITE(numout,*) 
    1011995      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    1012996      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    1013       IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc' 
    1014  
    1015  
    1016       ! 1. Define NETCDF files and fields at beginning of first time step 
    1017       ! ----------------------------------------------------------------- 
    1018  
    1019       ! Compute julian date from starting date of the run 
    1020       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
    1021       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    1022       CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    1023           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    1024       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    1025           "m", jpk, gdept_1d, nz_i, "down") 
    1026  
    1027       ! Declare all the output fields as NetCDF variables 
    1028  
    1029       CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity 
    1030          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1031       CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature 
    1032          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1033       CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh 
    1034          &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout ) 
    1035       CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current 
    1036          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1037       CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current 
    1038          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1039       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    1040          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1041          ! 
     997      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
     998 
     999#if defined key_si3 
     1000     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 
     1001#else 
     1002     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     1003#endif 
     1004 
     1005      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
     1006      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
     1007      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
     1008      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
     1009      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     1010      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    10421011      IF( ALLOCATED(ahtu) ) THEN 
    1043          CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
    1044             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1045          CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
    1046             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1047       ENDIF 
    1048       IF( ALLOCATED(ahmt) ) THEN  
    1049          CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
    1050             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1051          CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
    1052             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1053       ENDIF 
    1054          ! 
    1055       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    1056          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1057       CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    1058          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1059       CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux 
    1060          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1061       CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i 
    1062          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1063       CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress 
    1064          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1065       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    1066          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1067       IF( .NOT.ln_linssh ) THEN 
    1068          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth 
    1069             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1070          CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth 
    1071             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1072       ENDIF 
    1073       ! 
     1012         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
     1013         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point 
     1014      ENDIF 
     1015      IF( ALLOCATED(ahmt) ) THEN 
     1016         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point 
     1017         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point 
     1018      ENDIF 
     1019      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
     1020      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
     1021      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
     1022      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
     1023      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
     1024      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     1025      IF(  .NOT.ln_linssh  ) THEN              
     1026         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
     1027         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     1028      END IF 
    10741029      IF( ln_wave .AND. ln_sdw ) THEN 
    1075          CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current 
    1076             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1077          CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current 
    1078             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1079          CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current 
    1080             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1081       ENDIF 
    1082  
     1030         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity 
     1031         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity 
     1032         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
     1033      ENDIF 
     1034  
    10831035#if defined key_si3 
    10841036      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
    1085          CALL ice_wri_state( kt, id_i, nh_i ) 
    1086       ENDIF 
    1087 #else 
    1088       CALL histend( id_i, snc4chunks=snc4set ) 
     1037         CALL ice_wri_state( inum ) 
     1038      ENDIF 
    10891039#endif 
    1090  
    1091       ! 2. Start writing data 
    1092       ! --------------------- 
    1093       ! idex(1) est utilise ssi l'avant dernier argument est diffferent de  
    1094       ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    1095       ! donne le nombre d'elements, et idex la liste des indices a sortir 
    1096       idex(1) = 1   ! init to avoid compil warning 
    1097  
    1098       ! Write all fields on T grid 
    1099       CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
    1100       CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
    1101       CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
    1102       CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
    1103       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    1104       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    1105       ! 
    1106       IF( ALLOCATED(ahtu) ) THEN 
    1107          CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
    1108          CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
    1109       ENDIF 
    1110       IF( ALLOCATED(ahmt) ) THEN 
    1111          CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
    1112          CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
    1113       ENDIF 
    1114       ! 
    1115       CALL histwrite( id_i, "sowaflup", kt, emp - rnf        , jpi*jpj    , idex )    ! freshwater budget 
    1116       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1117       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    1118       CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
    1119       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    1120       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    1121  
    1122       IF(  .NOT.ln_linssh  ) THEN              
    1123          CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth  
    1124          CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness   
    1125       END IF  
    1126   
    1127       IF( ln_wave .AND. ln_sdw ) THEN 
    1128          CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity 
    1129          CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity 
    1130          CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity 
    1131       ENDIF 
    1132  
    1133       ! 3. Close the file 
    1134       ! ----------------- 
    1135       CALL histclo( id_i ) 
    1136 #if ! defined key_iomput 
    1137       IF( ninist /= 1  ) THEN 
    1138          CALL histclo( nid_T ) 
    1139          CALL histclo( nid_U ) 
    1140          CALL histclo( nid_V ) 
    1141          CALL histclo( nid_W ) 
    1142       ENDIF 
    1143 #endif 
     1040      ! 
     1041      CALL iom_close( inum ) 
    11441042      !  
    11451043   END SUBROUTINE dia_wri_state 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/stpctl.F90

    r10314 r10358  
    3232   PUBLIC stp_ctl           ! routine called by step.F90 
    3333 
    34    INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
     34   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, istatus 
     35   LOGICAL  ::   lsomeoce 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6061      INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    6162      !! 
    62       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    63       INTEGER  ::   iih, ijh               ! local integers 
    64       INTEGER  ::   iiu, iju, iku          !   -       - 
    65       INTEGER  ::   iis, ijs, iks          !   -       - 
    66       REAL(wp) ::   zzz                    ! local real  
    67       INTEGER , DIMENSION(3) ::   ilocu, ilocs 
    68       INTEGER , DIMENSION(2) ::   iloch 
    69       REAL(wp), DIMENSION(4) ::   zmax 
     63      INTEGER                ::   ji, jj, jk          ! dummy loop indices 
     64      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
     65      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
     66      REAL(wp)               ::   zzz                 ! local real  
     67      REAL(wp), DIMENSION(5) ::   zmax 
     68      CHARACTER(len=20) :: clname 
    7069      !!---------------------------------------------------------------------- 
    7170      ! 
     
    7574         WRITE(numout,*) '~~~~~~~' 
    7675         !                                ! open time.step file 
    77          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     76         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    7877         !                                ! open run.stat file 
    79          CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    80  
    81          IF( lwm ) THEN 
    82             istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 
     78         IF( ln_ctl .AND. lwm ) THEN 
     79            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     80            clname = 'run.stat.nc' 
     81            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     82            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    8383            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    8484            istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    85             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 
     85            istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   ) 
     86            istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1  ) 
     87            istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2  ) 
    8688            istatus = NF90_ENDDEF(idrun) 
    8789         ENDIF 
    88           
    8990      ENDIF 
     91      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    9092      ! 
    91       IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     93      IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file) 
    9294         WRITE ( numstp, '(1x, i8)' )   kt 
    9395         REWIND( numstp ) 
     
    101103      ENDIF 
    102104      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only) 
    103 !     zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    104       zmax(3) = 0.0_wp 
    105       zmax(4) = REAL( nstop , wp )                                            ! stop indicator 
     105      zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
     106      zmax(4) = MAXVAL(  tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
     107      zmax(5) = REAL( nstop , wp )                                            ! stop indicator 
    106108      ! 
    107       IF( lk_mpp ) THEN 
    108          CALL mpp_max_multiple( zmax(:), 4 )    ! max over the global domain 
    109          ! 
    110          nstop = INT( zmax(4) )                 ! nstop indicator sheared among all local domains 
     109      IF( lk_mpp .AND. ln_ctl ) THEN 
     110         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
     111         nstop = NINT( zmax(5) )                 ! nstop indicator sheared among all local domains 
    111112      ENDIF 
    112       ! 
    113       IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
    114          WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2) 
    115       ENDIF 
    116       ! 
    117       IF (  zmax(1) >  50._wp .OR.   &                     ! too large sea surface height ( > 10 m) 
    118          &  zmax(2) >  20._wp .OR.   &                     ! too large velocity ( > 10 m/s) 
    119 !!$         &  zmax(3) >=  0._wp .OR.   &                     ! negative or zero sea surface salinity 
    120          &  ISNAN( zmax(1) + zmax(2) + zmax(3) )  ) THEN   ! NaN encounter in the tests 
    121          IF( lk_mpp ) THEN 
    122             CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, iih, ijh ) 
    123             CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iiu, iju, iku ) 
    124 !           CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, iis, ijs, iks ) 
    125          ELSE 
    126             iloch = MINLOC( ABS( sshn(:,:)   )                               ) 
    127             ilocu = MAXLOC( ABS( un  (:,:,:) )                               ) 
    128 !           ilocs = MINLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 
    129             iih = iloch(1) + nimpp - 1   ;   ijh = iloch(2) + njmpp - 1 
    130             iiu = ilocu(1) + nimpp - 1   ;   iju = ilocu(2) + njmpp - 1   ;   iku = ilocu(3) 
    131 !           iis = ilocs(1) + nimpp - 1   ;   ijs = ilocs(2) + njmpp - 1   ;   iks = ilocu(3) 
    132          ENDIF 
    133          IF(lwp) THEN 
    134             WRITE(numout,cform_err) 
    135             WRITE(numout,*) ' stp_ctl: |ssh| > 50 m   or   |U| > 20 m/s   or   NaN encounter in the tests' 
    136             WRITE(numout,*) ' ======= ' 
    137             WRITE(numout,9100) kt,   zmax(1), iih, ijh 
    138             WRITE(numout,9200) kt,   zmax(2), iiu, iju, iku 
    139 !!$            WRITE(numout,9300) kt, - zmax(3), iis, ijs, iks 
    140             WRITE(numout,*) 
    141             WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
    142          ENDIF 
    143          kindic = -3 
    144          ! 
    145          nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
    146          CALL dia_wri_state( 'output.abort', kt )     ! create an output.abort file 
    147          ! 
    148       ENDIF 
    149 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    150 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    151 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j  : ',2i5) 
    152       ! 
    153       !                                            !==  run statistics  ==!   ("run.stat" file) 
    154 !     IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 
    155       IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2) 
    156       IF( lwm ) THEN 
     113      !                                   !==  run statistics  ==!   ("run.stat" files) 
     114      IF( ln_ctl .AND. lwm ) THEN 
     115         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    157116         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    158117         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    159 !        istatus = NF90_PUT_VAR( idrun,   ids, (/-zmax(3)/), (/kt/), (/1/) ) 
     118         istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
     119         istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
    160120         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    161121         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    162122      END IF 
     123      !                                   !==  error handling  ==! 
     124      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 
     125         &  zmax(1) >   50._wp .OR.   &                    ! too large sea surface height ( > 50 m ) 
     126         &  zmax(2) >   20._wp .OR.   &                    ! too large velocity ( > 20 m/s) 
     127         &  zmax(3) >= 100._wp .OR.   &                    ! too small sea surface salinity ( < -100 ) 
     128         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
     129         &  zmax(4) < -100._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
     130         &  ISNAN( zmax(1) + zmax(2) + zmax(3) )  ) THEN   ! NaN encounter in the tests 
     131         IF( lk_mpp .AND. ln_ctl ) THEN 
     132            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
     133            CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  ) 
     134            CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 
     135            CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 
     136         ELSE 
     137            ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
     138            iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     139            is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     140            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     141         ENDIF 
     142         IF( numout == 6 )   &   ! force to open ocean.output file 
     143            CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     144 
     145         WRITE(numout,cform_err) 
     146         WRITE(numout,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  S <= -100  or  S >= 100  or  NaN encounter in the tests' 
     147         WRITE(numout,*) ' ======= ' 
     148         IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 
     149         WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2) 
     150         WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
     151         WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
     152         WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
     153         WRITE(numout,*) 
     154         WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
     155          
     156         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file 
     157          
     158         IF( ln_ctl ) THEN 
     159            kindic = -3 
     160            nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
     161         ELSE 
     162            CALL ctl_stop() 
     163            CALL mppstop(ld_force_abort = .true.) 
     164         ENDIF 
     165         ! 
     166      ENDIF 
    163167      ! 
    164 !9400  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16) 
    165 9400  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16) 
     1689100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
     1699200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
     1709300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
     1719400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     1729500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    166173      ! 
    167174   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.