New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10425 for NEMO/trunk/tests – NEMO

Changeset 10425 for NEMO/trunk/tests


Ignore:
Timestamp:
2018-12-19T22:54:16+01:00 (5 years ago)
Author:
smasson
Message:

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

Location:
NEMO/trunk/tests
Files:
22 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90

    r10074 r10425  
    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(:,:,:) ) 
     
    185185            END DO 
    186186         END DO 
    187          CALL lbc_lnk( z2d, 'T', 1. ) 
     187         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    188188         CALL iom_put( "taubot", z2d )            
    189189      ENDIF 
     
    244244            END DO 
    245245         END DO 
    246          CALL lbc_lnk( z3d, 'T', 1. ) 
     246         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    247247         CALL iom_put( "salgrad2",  z3d )          ! square of module of sal gradient 
    248248         z3d(:,:,:) = SQRT( z3d(:,:,:) ) 
     
    260260            END DO 
    261261         END DO 
    262          CALL lbc_lnk( z2d, 'T', 1. ) 
     262         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    263263         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient 
    264264         z2d(:,:) = SQRT( z2d(:,:) ) 
     
    314314            END DO 
    315315         END DO 
    316          CALL lbc_lnk( z3d, 'T', 1. ) 
     316         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    317317         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    318318      ENDIF 
     
    335335         END DO 
    336336          
    337          CALL lbc_lnk( z3d, 'T', 1. ) 
     337         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    338338         CALL iom_put( "ke", z3d ) ! kinetic energy 
    339339 
     
    363363            END DO 
    364364         END DO 
    365          CALL lbc_lnk( z3d, 'F', 1. ) 
     365         CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 
    366366         CALL iom_put( "relvor", z3d )                  ! relative vorticity 
    367367 
     
    387387            END DO 
    388388         END DO 
    389          CALL lbc_lnk( z3d, 'F', 1. ) 
     389         CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 
    390390         CALL iom_put( "potvor", z3d )                  ! potential vorticity 
    391391 
     
    413413            END DO 
    414414         END DO 
    415          CALL lbc_lnk( z2d, 'U', -1. ) 
     415         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    416416         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction 
    417417      ENDIF 
     
    426426            END DO 
    427427         END DO 
    428          CALL lbc_lnk( z2d, 'U', -1. ) 
     428         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    429429         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction 
    430430      ENDIF 
     
    448448            END DO 
    449449         END DO 
    450          CALL lbc_lnk( z2d, 'V', -1. ) 
     450         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    451451         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction 
    452452      ENDIF 
     
    461461            END DO 
    462462         END DO 
    463          CALL lbc_lnk( z2d, 'V', -1. ) 
     463         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    464464         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction 
    465465      ENDIF 
     
    474474            END DO 
    475475         END DO 
    476          CALL lbc_lnk( z2d, 'T', -1. ) 
     476         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    477477         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature 
    478478      ENDIF 
     
    486486            END DO 
    487487         END DO 
    488          CALL lbc_lnk( z2d, 'T', -1. ) 
     488         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    489489         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity 
    490490      ENDIF 
     
    505505   !!   Default option                                  use IOIPSL  library 
    506506   !!---------------------------------------------------------------------- 
    507     
     507 
    508508   INTEGER FUNCTION dia_wri_alloc() 
    509509      !!---------------------------------------------------------------------- 
     
    516516         ! 
    517517      dia_wri_alloc = MAXVAL(ierr) 
    518       IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc ) 
     518      CALL mpp_sum( 'diawri', dia_wri_alloc ) 
    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 
     
    625625            !! that routine is called from nemogcm, so do it here immediately before its needed 
    626626            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 
    627             IF( lk_mpp )   CALL mpp_sum( ierror ) 
     627            CALL mpp_sum( 'diawri', ierror ) 
    628628            IF( ierror /= 0 ) THEN 
    629629               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') 
     
    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., kdlev = jpl ) 
     1001#else 
     1002     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     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/trunk/tests/CANAL/MY_SRC/domvvl.F90

    r10074 r10425  
    7979            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   & 
    8080            &      STAT = dom_vvl_alloc        ) 
    81          IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    82          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
     81         CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 
     82         IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 
    8383         un_td = 0._wp 
    8484         vn_td = 0._wp 
     
    8686      IF( ln_vvl_ztilde ) THEN 
    8787         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc ) 
    88          IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    89          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
     88         CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 
     89         IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 
    9090      ENDIF 
    9191      ! 
     
    147147      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW 
    148148      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     149 
     150      ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 
     151      e3t_a(:,:,:) = e3t_n(:,:,:) 
     152      e3u_a(:,:,:) = e3u_n(:,:,:) 
     153      e3v_a(:,:,:) = e3v_n(:,:,:) 
    149154      ! 
    150155      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
     
    229234               END DO 
    230235            END DO 
    231             IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    232                ii0 = 103   ;   ii1 = 111        
    233                ij0 = 128   ;   ij1 = 135   ;    
    234                frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    235                frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
     236            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
     237               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
     238                  ii0 = 103   ;   ii1 = 111        
     239                  ij0 = 128   ;   ij1 = 135   ;    
     240                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
     241                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
     242               ENDIF 
    236243            ENDIF 
    237244         ENDIF 
     245      ENDIF 
     246      ! 
     247      IF(lwxios) THEN 
     248! define variables in restart file when writing with XIOS 
     249         CALL iom_set_rstw_var_active('e3t_b') 
     250         CALL iom_set_rstw_var_active('e3t_n') 
     251         !                                           ! ----------------------- ! 
     252         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
     253            !                                        ! ----------------------- ! 
     254            CALL iom_set_rstw_var_active('tilde_e3t_b') 
     255            CALL iom_set_rstw_var_active('tilde_e3t_n') 
     256         END IF 
     257         !                                           ! -------------!     
     258         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
     259            !                                        ! ------------ ! 
     260            CALL iom_set_rstw_var_active('hdiv_lf') 
     261         ENDIF 
     262         ! 
    238263      ENDIF 
    239264      ! 
     
    385410         !                       ! d - thickness diffusion transport: boundary conditions 
    386411         !                             (stored for tracer advction and continuity equation) 
    387          CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     412         CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    388413 
    389414         ! 4 - Time stepping of baroclinic scale factors 
     
    396421            z2dt = 2.0_wp * rdt 
    397422         ENDIF 
    398          CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
     423         CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    399424         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    400425 
     
    406431         END DO 
    407432         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    408          IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain 
     433         CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    409434         z_tmin = MINVAL( ze3t(:,:,:) ) 
    410          IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain 
     435         CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
    411436         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    412437         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    413438            IF( lk_mpp ) THEN 
    414                CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) 
    415                CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3) ) 
     439               CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
     440               CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    416441            ELSE 
    417442               ijk_max = MAXLOC( ze3t(:,:,:) ) 
     
    427452               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    428453               WRITE(numout, *) 'at i, j, k=', ijk_min             
    429                CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 
     454               CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 
    430455            ENDIF 
    431456         ENDIF 
     
    470495         IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    471496            z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 
    472             IF( lk_mpp ) CALL mpp_max( z_tmax )                             ! max over the global domain 
     497            CALL mpp_max( 'domvvl', z_tmax )                             ! max over the global domain 
    473498            IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 
    474499         END IF 
     
    479504         END DO 
    480505         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 
    481          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     506         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    482507         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 
    483508         ! 
     
    487512         END DO 
    488513         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 
    489          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     514         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    490515         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 
    491516         ! 
     
    495520         END DO 
    496521         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 
    497          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     522         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    498523         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 
    499524         ! 
    500525         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) ) 
    501          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     526         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    502527         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 
    503528         ! 
    504529         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshn(:,:) ) ) 
    505          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     530         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    506531         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 
    507532         ! 
    508533         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssha(:,:) ) ) 
    509          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     534         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    510535         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 
    511536      END IF 
     
    688713            END DO 
    689714         END DO 
    690          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
     715         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    691716         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    692717         ! 
     
    701726            END DO 
    702727         END DO 
    703          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
     728         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    704729         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    705730         ! 
     
    715740            END DO 
    716741         END DO 
    717          CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
     742         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    718743         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    719744         ! 
     
    781806         IF( ln_rstart ) THEN                   !* Read the restart file 
    782807            CALL rst_read_open                  !  open the restart file if necessary 
    783             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
     808            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios    ) 
    784809            ! 
    785810            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
     
    792817            !                             ! --------- ! 
    793818            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    794                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
    795                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
     819               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 
     820               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 
    796821               ! needed to restart if land processor not computed  
    797822               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' 
     
    807832               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    808833               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    809                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
     834               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 
    810835               e3t_n(:,:,:) = e3t_b(:,:,:) 
    811836               neuler = 0 
     
    814839               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    815840               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    816                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
     841               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 
    817842               e3t_b(:,:,:) = e3t_n(:,:,:) 
    818843               neuler = 0 
     
    839864               !                          ! ----------------------- ! 
    840865               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    841                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
    842                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
     866                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     867                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    843868               ELSE                            ! one at least array is missing 
    844869                  tilde_e3t_b(:,:,:) = 0.0_wp 
     
    849874                  !                       ! ------------ ! 
    850875                  IF( id5 > 0 ) THEN  ! required array exists 
    851                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) ) 
     876                     CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    852877                  ELSE                ! array is missing 
    853878                     hdiv_lf(:,:,:) = 0.0_wp 
     
    929954         !                                   ! =================== 
    930955         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
     956         IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    931957         !                                           ! --------- ! 
    932958         !                                           ! all cases ! 
    933959         !                                           ! --------- ! 
    934          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) ) 
    935          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) 
     960         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:), ldxios = lwxios ) 
     961         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) 
    936962         !                                           ! ----------------------- ! 
    937963         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    938964            !                                        ! ----------------------- ! 
    939             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
    940             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
     965            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
     966            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
    941967         END IF 
    942968         !                                           ! -------------!     
    943969         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    944970            !                                        ! ------------ ! 
    945             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    946          ENDIF 
    947          ! 
     971            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     972         ENDIF 
     973         ! 
     974         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    948975      ENDIF 
    949976      ! 
  • NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90

    r10074 r10425  
    2424   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2525   USE lib_mpp         ! distributed memory computing 
     26   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    2627   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    2728 
     
    3233   PUBLIC stp_ctl           ! routine called by step.F90 
    3334 
    34    INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
     35   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
     36   LOGICAL  ::   lsomeoce 
    3537   !!---------------------------------------------------------------------- 
    3638   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6062      INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    6163      !! 
    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 
     64      INTEGER                ::   ji, jj, jk          ! dummy loop indices 
     65      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
     66      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
     67      REAL(wp)               ::   zzz                 ! local real  
     68      REAL(wp), DIMENSION(9) ::   zmax 
     69      CHARACTER(len=20) :: clname 
    7070      !!---------------------------------------------------------------------- 
    7171      ! 
     
    7575         WRITE(numout,*) '~~~~~~~' 
    7676         !                                ! open time.step file 
    77          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     77         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    7878         !                                ! 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 ) 
     79         IF( ln_ctl .AND. lwm ) THEN 
     80            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     81            clname = 'run.stat.nc' 
     82            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     83            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    8384            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    8485            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 ) 
     86            istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   ) 
     87            istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1  ) 
     88            istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2  ) 
     89            istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1  ) 
     90            istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2  ) 
     91            IF( ln_zad_Aimp ) THEN 
     92               istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1  ) 
     93               istatus = NF90_DEF_VAR( idrun,       'Cu_max', NF90_DOUBLE, (/ idtime /), idc1  ) 
     94            ENDIF 
    8695            istatus = NF90_ENDDEF(idrun) 
     96            zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use 
    8797         ENDIF 
    88           
    8998      ENDIF 
     99      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    90100      ! 
    91       IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     101      IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file) 
    92102         WRITE ( numstp, '(1x, i8)' )   kt 
    93103         REWIND( numstp ) 
     
    101111      ENDIF 
    102112      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 
    106       ! 
    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 
     113      zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
     114      zmax(4) = MAXVAL(  tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
     115      zmax(5) = MAXVAL( -tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
     116      zmax(6) = MAXVAL(  tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
     117      zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
     118      IF( ln_zad_Aimp ) THEN 
     119         zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 
     120         zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) !       cell Courant no. max 
    111121      ENDIF 
    112122      ! 
    113       IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
    114          WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2) 
     123      IF( lk_mpp .AND. ln_ctl ) THEN 
     124         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
     125         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    115126      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( ABS(sshn)        , ssmask(:,:)  , zzz, iih, ijh ) 
    123             CALL mpp_maxloc( ABS(un)          , umask (:,:,:), zzz, iiu, iju, iku ) 
    124 !           CALL mpp_minloc( 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 
     127      !                                   !==  run statistics  ==!   ("run.stat" files) 
     128      IF( ln_ctl .AND. lwm ) THEN 
     129         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    157130         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    158131         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    159 !        istatus = NF90_PUT_VAR( idrun,   ids, (/-zmax(3)/), (/kt/), (/1/) ) 
     132         istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
     133         istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
     134         istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) ) 
     135         istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) ) 
     136         IF( ln_zad_Aimp ) THEN 
     137            istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) ) 
     138            istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) ) 
     139         ENDIF 
    160140         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    161141         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    162142      END IF 
     143      !                                   !==  error handling  ==! 
     144      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 
     145         &  zmax(1) >   50._wp .OR.   &                    ! too large sea surface height ( > 50 m ) 
     146         &  zmax(2) >   20._wp .OR.   &                    ! too large velocity ( > 20 m/s) 
     147         &  zmax(3) >= 100._wp .OR.   &                    ! too small sea surface salinity ( < -100 ) 
     148         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
     149         &  zmax(4) < -100._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
     150         &  ISNAN( zmax(1) + zmax(2) + zmax(3) )  ) THEN   ! NaN encounter in the tests 
     151         IF( lk_mpp .AND. ln_ctl ) THEN 
     152            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
     153            CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  ) 
     154            CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 
     155            CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 
     156         ELSE 
     157            ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
     158            iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     159            is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     160            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     161         ENDIF 
     162         IF( numout == 6 )   &   ! force to open ocean.output file 
     163            CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     164 
     165         WRITE(numout,cform_err) 
     166         WRITE(numout,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  S <= -100  or  S >= 100  or  NaN encounter in the tests' 
     167         WRITE(numout,*) ' ======= ' 
     168         IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 
     169         WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2) 
     170         WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
     171         WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
     172         WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
     173         WRITE(numout,*) 
     174         WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
     175          
     176         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file 
     177          
     178         IF( ln_ctl ) THEN 
     179            kindic = -3 
     180            nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
     181         ELSE 
     182            CALL ctl_stop() 
     183            CALL mppstop(ld_force_abort = .true.) 
     184         ENDIF 
     185         ! 
     186      ENDIF 
    163187      ! 
    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) 
     1889100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
     1899200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
     1909300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
     1919400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     1929500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    166193      ! 
    167194   END SUBROUTINE stp_ctl 
  • NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90

    r10074 r10425  
    9292         END DO 
    9393!!gm this should be moved in trdtra.F90 and done on all trends 
    94          CALL lbc_lnk_multi( ztrdt, 'T', 1. , ztrds, 'T', 1. ) 
     94         CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1. , ztrds, 'T', 1. ) 
    9595!!gm 
    9696         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

    r10074 r10425  
    169169               END DO 
    170170            END DO 
    171             CALL lbc_lnk( pssh, 'T',  1. ) 
     171            CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    172172         END DO 
    173173          
     
    293293         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    294294      END IF 
    295       CALL lbc_lnk( pssh, 'T',  1. ) 
    296       CALL lbc_lnk(  pts, 'T',  1. ) 
    297       CALL lbc_lnk(   pu, 'U', -1. ) 
    298       CALL lbc_lnk(   pv, 'V', -1. ) 
     295      CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
     296      CALL lbc_lnk(  'usrdef_istate', pts, 'T',  1. ) 
     297      CALL lbc_lnk(   'usrdef_istate', pu, 'U', -1. ) 
     298      CALL lbc_lnk(   'usrdef_istate', pv, 'V', -1. ) 
    299299 
    300300   END SUBROUTINE usr_def_istate 
  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    198198      CASE(1) 
    199199         zmaxlam = MAXVAL(glamt) 
    200          IF( lk_mpp )   CALL mpp_max( zmaxlam )                 ! max over the global domain 
     200         CALL mpp_max( 'usrdef_zgr', zmaxlam )                 ! max over the global domain 
    201201         zscl = rpi / zmaxlam 
    202202         z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ) ) 
     
    204204      END SELECT 
    205205      ! 
    206       CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
     206      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    207207      ! 
    208208      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
  • NEMO/trunk/tests/CANAL/cpp_CANAL.fcm

    r9302 r10425  
    1  bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero  
     1 bld::tool::fppkeys key_iomput key_mpp_mpi  
  • NEMO/trunk/tests/ICEDYN/cpp_ICEDYN.fcm

    r9789 r10425  
    1 bld::tool::fppkeys key_agrif key_si3 key_mpp_mpi key_nosignedzero key_iomput 
     1bld::tool::fppkeys key_agrif key_si3 key_mpp_mpi key_iomput 
  • NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    8989      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    9090      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    91       CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
     91      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    9292      zmsk(:,:) = NINT( z2d(:,:) ) 
    9393      ! 
     
    177177            END DO 
    178178         END DO 
    179          CALL lbc_lnk( pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( pe3vw, 'V', 1._wp ) 
    180          CALL lbc_lnk( pe3f , 'F', 1._wp ) 
     179         CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) 
     180         CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp ) 
    181181         DO jk = 1, jpk 
    182182            ! set to z-scale factor if zero (i.e. along closed boundaries) because of lbclnk 
  • NEMO/trunk/tests/ISOMIP/cpp_ISOMIP.fcm

    r9139 r10425  
    1  bld::tool::fppkeys   key_iomput key_mpp_mpi key_nosignedzero  
     1 bld::tool::fppkeys   key_iomput key_mpp_mpi  
  • NEMO/trunk/tests/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    8888      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    8989      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    90       CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
     90      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    9191      k_top(:,:) = NINT( z2d(:,:) ) 
    9292      ! 
  • NEMO/trunk/tests/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm

    r9139 r10425  
    1  bld::tool::fppkeys   key_iomput key_mpp_mpi key_nosignedzero 
     1 bld::tool::fppkeys   key_iomput key_mpp_mpi  
  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    9393         zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) 
    9494      END DO 
    95       CALL lbc_lnk( zhu, 'U', 1. )     ! boundary condition: this mask the surrouding grid-points 
     95      CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. )     ! boundary condition: this mask the surrouding grid-points 
    9696      !                                ! ==>>>  set by hand non-zero value on first/last columns & rows  
    9797      DO ji = mi0(1), mi1(1)              ! first row of global domain only 
     
    112112      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    113113      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    114       CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
     114      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    115115      k_top(:,:) = NINT( z2d(:,:) ) 
    116116      ! 
  • NEMO/trunk/tests/OVERFLOW/cpp_OVERFLOW.fcm

    r9139 r10425  
    1 bld::tool::fppkeys   key_mpp_mpi key_iomput key_nosignedzero 
     1bld::tool::fppkeys   key_mpp_mpi key_iomput  
  • NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90

    r10074 r10425  
    7979            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   & 
    8080            &      STAT = dom_vvl_alloc        ) 
    81          IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    82          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
     81         CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 
     82         IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 
    8383         un_td = 0._wp 
    8484         vn_td = 0._wp 
     
    8686      IF( ln_vvl_ztilde ) THEN 
    8787         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc ) 
    88          IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    89          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
     88         CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 
     89         IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 
    9090      ENDIF 
    9191      ! 
     
    234234               END DO 
    235235            END DO 
    236             IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    237                ii0 = 103   ;   ii1 = 111        
    238                ij0 = 128   ;   ij1 = 135   ;    
    239                frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    240                frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
     236            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
     237               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
     238                  ii0 = 103   ;   ii1 = 111        
     239                  ij0 = 128   ;   ij1 = 135   ;    
     240                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
     241                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
     242               ENDIF 
    241243            ENDIF 
    242244         ENDIF 
     
    408410         !                       ! d - thickness diffusion transport: boundary conditions 
    409411         !                             (stored for tracer advction and continuity equation) 
    410          CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     412         CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    411413 
    412414         ! 4 - Time stepping of baroclinic scale factors 
     
    419421            z2dt = 2.0_wp * rdt 
    420422         ENDIF 
    421          CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
     423         CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    422424         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    423425 
     
    429431         END DO 
    430432         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    431          IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain 
     433         CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    432434         z_tmin = MINVAL( ze3t(:,:,:) ) 
    433          IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain 
     435         CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
    434436         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    435437         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    436438            IF( lk_mpp ) THEN 
    437                CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) 
    438                CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3) ) 
     439               CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
     440               CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    439441            ELSE 
    440442               ijk_max = MAXLOC( ze3t(:,:,:) ) 
     
    450452               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    451453               WRITE(numout, *) 'at i, j, k=', ijk_min             
    452                CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 
     454               CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 
    453455            ENDIF 
    454456         ENDIF 
     
    493495         IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    494496            z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 
    495             IF( lk_mpp ) CALL mpp_max( z_tmax )                             ! max over the global domain 
     497            CALL mpp_max( 'domvvl', z_tmax )                             ! max over the global domain 
    496498            IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 
    497499         END IF 
     
    502504         END DO 
    503505         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 
    504          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     506         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    505507         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 
    506508         ! 
     
    510512         END DO 
    511513         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 
    512          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     514         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    513515         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 
    514516         ! 
     
    518520         END DO 
    519521         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 
    520          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     522         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    521523         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 
    522524         ! 
    523525         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) ) 
    524          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     526         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    525527         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 
    526528         ! 
    527529         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshn(:,:) ) ) 
    528          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     530         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    529531         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 
    530532         ! 
    531533         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssha(:,:) ) ) 
    532          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     534         CALL mpp_max( 'domvvl', z_tmax )                                ! max over the global domain 
    533535         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 
    534536      END IF 
     
    711713            END DO 
    712714         END DO 
    713          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
     715         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    714716         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    715717         ! 
     
    724726            END DO 
    725727         END DO 
    726          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
     728         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    727729         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    728730         ! 
     
    738740            END DO 
    739741         END DO 
    740          CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
     742         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    741743         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    742744         ! 
  • NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r10074 r10425  
    136136      END DO 
    137137 
    138       CALL lbc_lnk( pu, 'U', -1. ) 
    139       CALL lbc_lnk( pv, 'V', -1. ) 
     138      CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 
     139      CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 
    140140      !    
    141141   END SUBROUTINE usr_def_istate 
  • NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    192192      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    193193      ! 
    194       CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
     194      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    195195      ! 
    196196      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
  • NEMO/trunk/tests/VORTEX/cpp_VORTEX.fcm

    r9228 r10425  
    1  bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero key_agrif 
     1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif 
  • NEMO/trunk/tests/WAD/MY_SRC/bdyini.F90

    r10074 r10425  
    11331133         END DO 
    11341134      END DO 
    1135       CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1. )   ! Lateral boundary cond.  
     1135      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1. )   ! Lateral boundary cond.  
    11361136 
    11371137      ! bdy masks are now set to zero on boundary points: 
     
    11691169 
    11701170      ! Lateral boundary conditions 
    1171       CALL lbc_lnk( zfmask, 'F', 1. )  
    1172       CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 
     1171      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )  
     1172      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 
    11731173      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    11741174 
     
    12801280         END DO 
    12811281         ! 
    1282          IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain 
     1282         CALL mpp_sum( 'bdyini', bdysurftot )      ! sum over the global domain 
    12831283      END IF    
    12841284      ! 
     
    15201520            END DO 
    15211521         END DO 
    1522          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
     1522         CALL mpp_sum( 'bdyini', ztestmask, 2 )   ! sum over the global domain 
    15231523 
    15241524         IF (ztestmask(1)==1) THEN  
     
    15641564            END DO 
    15651565         END DO 
    1566          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
     1566         CALL mpp_sum( 'bdyini', ztestmask, 2 )   ! sum over the global domain 
    15671567 
    15681568         IF (ztestmask(1)==1) THEN 
     
    16081608            END DO 
    16091609         END DO 
    1610          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
     1610         CALL mpp_sum( 'bdyini', ztestmask, 2 )   ! sum over the global domain 
    16111611 
    16121612         IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN 
     
    16381638            END DO 
    16391639         END DO 
    1640          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
     1640         CALL mpp_sum( 'bdyini', ztestmask, 2 )   ! sum over the global domain 
    16411641 
    16421642         IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN 
  • NEMO/trunk/tests/WAD/MY_SRC/usrdef_zgr.F90

    r10074 r10425  
    234234         zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) 
    235235      END DO 
    236       CALL lbc_lnk( zhu, 'U', 1. )     ! boundary condition: this mask the surrounding grid-points 
     236      CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. )     ! boundary condition: this mask the surrounding grid-points 
    237237      !                                ! ==>>>  set by hand non-zero value on first/last columns & rows  
    238238      DO ji = mi0(1), mi1(1)              ! first row of global domain only 
     
    247247         zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) ) 
    248248      END DO 
    249       CALL lbc_lnk( zhv, 'V', 1. )     ! boundary condition: this mask the surrounding grid-points 
     249      CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. )     ! boundary condition: this mask the surrounding grid-points 
    250250      DO jj = mj0(1), mj1(1)   ! first  row of global domain only 
    251251         zhv(:,jj) = zht(:,jj) 
     
    272272 
    273273 
    274       CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
     274      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    275275      k_top(:,:) = NINT( z2d(:,:) ) 
    276276      ! 
     
    311311           END DO       
    312312         END DO       
    313          CALL lbc_lnk( pdept, 'T', 1. ) 
    314          CALL lbc_lnk( pdepw, 'T', 1. ) 
    315          CALL lbc_lnk( pe3t , 'T', 1. ) 
    316          CALL lbc_lnk( pe3w , 'T', 1. ) 
    317          CALL lbc_lnk( pe3u , 'U', 1. ) 
    318          CALL lbc_lnk( pe3uw, 'U', 1. ) 
    319          CALL lbc_lnk( pe3f , 'F', 1. ) 
    320          CALL lbc_lnk( pe3v , 'V', 1. ) 
    321          CALL lbc_lnk( pe3vw, 'V', 1. ) 
     313         CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. ) 
     314         CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. ) 
     315         CALL lbc_lnk( 'usrdef_zgr', pe3t , 'T', 1. ) 
     316         CALL lbc_lnk( 'usrdef_zgr', pe3w , 'T', 1. ) 
     317         CALL lbc_lnk( 'usrdef_zgr', pe3u , 'U', 1. ) 
     318         CALL lbc_lnk( 'usrdef_zgr', pe3uw, 'U', 1. ) 
     319         CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1. ) 
     320         CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1. ) 
     321         CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1. ) 
    322322         WHERE( pe3t (:,:,:) == 0._wp )   pe3t (:,:,:) = 1._wp 
    323323         WHERE( pe3u (:,:,:) == 0._wp )   pe3u (:,:,:) = 1._wp 
  • NEMO/trunk/tests/WAD/cpp_WAD.fcm

    r9139 r10425  
    1  bld::tool::fppkeys   key_iomput key_mpp_mpi key_nosignedzero 
     1 bld::tool::fppkeys   key_iomput key_mpp_mpi  
  • NEMO/trunk/tests/demo_cfgs.txt

    r10413 r10425  
    77VORTEX OCE NST 
    88WAD OCE 
    9  
     9BENCH OCE ICE TOP 
Note: See TracChangeset for help on using the changeset viewer.