Changeset 10425 for NEMO/trunk/tests
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- Location:
- NEMO/trunk/tests
- Files:
-
- 22 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90
r10074 r10425 52 52 53 53 #if defined key_si3 54 USE ice 54 55 USE icewri 55 56 #endif … … 89 90 !! 'key_iomput' use IOM library 90 91 !!---------------------------------------------------------------------- 91 92 92 INTEGER FUNCTION dia_wri_alloc() 93 93 ! … … 96 96 END FUNCTION dia_wri_alloc 97 97 98 98 99 99 SUBROUTINE dia_wri( kt ) 100 100 !!--------------------------------------------------------------------- … … 123 123 ! Output the initial state and forcings 124 124 IF( ninist == 1 ) THEN 125 CALL dia_wri_state( 'output.init' , kt)125 CALL dia_wri_state( 'output.init' ) 126 126 ninist = 0 127 127 ENDIF … … 129 129 ! Output of initial vertical scale factor 130 130 CALL iom_put("e3t_0", e3t_0(:,:,:) ) 131 CALL iom_put("e3u_0", e3 t_0(:,:,:) )132 CALL iom_put("e3v_0", e3 t_0(:,:,:) )131 CALL iom_put("e3u_0", e3u_0(:,:,:) ) 132 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 133 133 ! 134 134 CALL iom_put( "e3t" , e3t_n(:,:,:) ) … … 185 185 END DO 186 186 END DO 187 CALL lbc_lnk( z2d, 'T', 1. )187 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 188 188 CALL iom_put( "taubot", z2d ) 189 189 ENDIF … … 244 244 END DO 245 245 END DO 246 CALL lbc_lnk( z3d, 'T', 1. )246 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 247 247 CALL iom_put( "salgrad2", z3d ) ! square of module of sal gradient 248 248 z3d(:,:,:) = SQRT( z3d(:,:,:) ) … … 260 260 END DO 261 261 END DO 262 CALL lbc_lnk( z2d, 'T', 1. )262 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 263 263 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 264 264 z2d(:,:) = SQRT( z2d(:,:) ) … … 314 314 END DO 315 315 END DO 316 CALL lbc_lnk( z3d, 'T', 1. )316 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 317 317 CALL iom_put( "eken", z3d ) ! kinetic energy 318 318 ENDIF … … 335 335 END DO 336 336 337 CALL lbc_lnk( z3d, 'T', 1. )337 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 338 338 CALL iom_put( "ke", z3d ) ! kinetic energy 339 339 … … 363 363 END DO 364 364 END DO 365 CALL lbc_lnk( z3d, 'F', 1. )365 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 366 366 CALL iom_put( "relvor", z3d ) ! relative vorticity 367 367 … … 387 387 END DO 388 388 END DO 389 CALL lbc_lnk( z3d, 'F', 1. )389 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 390 390 CALL iom_put( "potvor", z3d ) ! potential vorticity 391 391 … … 413 413 END DO 414 414 END DO 415 CALL lbc_lnk( z2d, 'U', -1. )415 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 416 416 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 417 417 ENDIF … … 426 426 END DO 427 427 END DO 428 CALL lbc_lnk( z2d, 'U', -1. )428 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 429 429 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 430 430 ENDIF … … 448 448 END DO 449 449 END DO 450 CALL lbc_lnk( z2d, 'V', -1. )450 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 451 451 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 452 452 ENDIF … … 461 461 END DO 462 462 END DO 463 CALL lbc_lnk( z2d, 'V', -1. )463 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 464 464 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 465 465 ENDIF … … 474 474 END DO 475 475 END DO 476 CALL lbc_lnk( z2d, 'T', -1. )476 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 477 477 CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature 478 478 ENDIF … … 486 486 END DO 487 487 END DO 488 CALL lbc_lnk( z2d, 'T', -1. )488 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 489 489 CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity 490 490 ENDIF … … 505 505 !! Default option use IOIPSL library 506 506 !!---------------------------------------------------------------------- 507 507 508 508 INTEGER FUNCTION dia_wri_alloc() 509 509 !!---------------------------------------------------------------------- … … 516 516 ! 517 517 dia_wri_alloc = MAXVAL(ierr) 518 IF( lk_mpp ) CALL mpp_sum(dia_wri_alloc )518 CALL mpp_sum( 'diawri', dia_wri_alloc ) 519 519 ! 520 520 END FUNCTION dia_wri_alloc 521 522 521 522 523 523 SUBROUTINE dia_wri( kt ) 524 524 !!--------------------------------------------------------------------- … … 551 551 ! 552 552 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' ) 554 554 ninist = 0 555 555 ENDIF … … 625 625 !! that routine is called from nemogcm, so do it here immediately before its needed 626 626 ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 627 IF( lk_mpp ) CALL mpp_sum(ierror )627 CALL mpp_sum( 'diawri', ierror ) 628 628 IF( ierror /= 0 ) THEN 629 629 CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') … … 974 974 #endif 975 975 976 SUBROUTINE dia_wri_state( cdfile_name , kt)976 SUBROUTINE dia_wri_state( cdfile_name ) 977 977 !!--------------------------------------------------------------------- 978 978 !! *** ROUTINE dia_wri_state *** … … 988 988 !!---------------------------------------------------------------------- 989 989 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 997 992 !!---------------------------------------------------------------------- 998 993 ! 999 ! 0. Initialisation1000 ! -----------------1001 1002 ! Define name, frequency of output and means1003 clname = cdfile_name1004 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)1005 zsto = rdt1006 clop = "inst(x)" ! no use of the mask value (require less cpu time)1007 zout = rdt1008 zmax = ( nitend - nit000 + 1 ) * rdt1009 1010 994 IF(lwp) WRITE(numout,*) 1011 995 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 1012 996 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 1042 1011 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 1074 1029 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 1083 1035 #if defined key_si3 1084 1036 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 1089 1039 #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 ) 1144 1042 ! 1145 1043 END SUBROUTINE dia_wri_state -
NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90
r10074 r10425 79 79 & dtilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & 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' ) 83 83 un_td = 0._wp 84 84 vn_td = 0._wp … … 86 86 IF( ln_vvl_ztilde ) THEN 87 87 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' ) 90 90 ENDIF 91 91 ! … … 147 147 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) ! from V to UW 148 148 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(:,:,:) 149 154 ! 150 155 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) … … 229 234 END DO 230 235 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 236 243 ENDIF 237 244 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 ! 238 263 ENDIF 239 264 ! … … 385 410 ! ! d - thickness diffusion transport: boundary conditions 386 411 ! (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) 388 413 389 414 ! 4 - Time stepping of baroclinic scale factors … … 396 421 z2dt = 2.0_wp * rdt 397 422 ENDIF 398 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )423 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 399 424 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 400 425 … … 406 431 END DO 407 432 z_tmax = MAXVAL( ze3t(:,:,:) ) 408 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain433 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 409 434 z_tmin = MINVAL( ze3t(:,:,:) ) 410 IF( lk_mpp ) CALL mpp_min(z_tmin ) ! min over the global domain435 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 411 436 ! - ML - test: for the moment, stop simulation for too large e3_t variations 412 437 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 413 438 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 ) 416 441 ELSE 417 442 ijk_max = MAXLOC( ze3t(:,:,:) ) … … 427 452 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 428 453 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') 430 455 ENDIF 431 456 ENDIF … … 470 495 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 471 496 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 472 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain497 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 473 498 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 474 499 END IF … … 479 504 END DO 480 505 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 domain506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 482 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 483 508 ! … … 487 512 END DO 488 513 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 domain514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 490 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 491 516 ! … … 495 520 END DO 496 521 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 domain522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 498 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 499 524 ! 500 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 501 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 502 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 503 528 ! 504 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 505 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 506 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 507 532 ! 508 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 509 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 510 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 511 536 END IF … … 688 713 END DO 689 714 END DO 690 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )715 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 691 716 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 692 717 ! … … 701 726 END DO 702 727 END DO 703 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 704 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 705 730 ! … … 715 740 END DO 716 741 END DO 717 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )742 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 718 743 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 719 744 ! … … 781 806 IF( ln_rstart ) THEN !* Read the restart file 782 807 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 ) 784 809 ! 785 810 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 792 817 ! ! --------- ! 793 818 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 ) 796 821 ! needed to restart if land processor not computed 797 822 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' … … 807 832 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 808 833 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 ) 810 835 e3t_n(:,:,:) = e3t_b(:,:,:) 811 836 neuler = 0 … … 814 839 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 815 840 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 ) 817 842 e3t_b(:,:,:) = e3t_n(:,:,:) 818 843 neuler = 0 … … 839 864 ! ! ----------------------- ! 840 865 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 ) 843 868 ELSE ! one at least array is missing 844 869 tilde_e3t_b(:,:,:) = 0.0_wp … … 849 874 ! ! ------------ ! 850 875 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 ) 852 877 ELSE ! array is missing 853 878 hdiv_lf(:,:,:) = 0.0_wp … … 929 954 ! ! =================== 930 955 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 956 IF( lwxios ) CALL iom_swap( cwxios_context ) 931 957 ! ! --------- ! 932 958 ! ! all cases ! 933 959 ! ! --------- ! 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 ) 936 962 ! ! ----------------------- ! 937 963 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 938 964 ! ! ----------------------- ! 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) 941 967 END IF 942 968 ! ! -------------! 943 969 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 944 970 ! ! ------------ ! 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 ) 948 975 ENDIF 949 976 ! -
NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90
r10074 r10425 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing 26 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 26 27 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 27 28 … … 32 33 PUBLIC stp_ctl ! routine called by step.F90 33 34 34 INTEGER :: idrun, idtime, idssh, idu, ids, istatus 35 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 36 LOGICAL :: lsomeoce 35 37 !!---------------------------------------------------------------------- 36 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 62 INTEGER, INTENT(inout) :: kindic ! error indicator 61 63 !! 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 70 70 !!---------------------------------------------------------------------- 71 71 ! … … 75 75 WRITE(numout,*) '~~~~~~~' 76 76 ! ! 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 ) 78 78 ! ! 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 ) 83 84 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 84 85 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 86 95 istatus = NF90_ENDDEF(idrun) 96 zmax(8:9) = 0._wp ! initialise to zero in case ln_zad_Aimp option is not in use 87 97 ENDIF 88 89 98 ENDIF 99 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 90 100 ! 91 IF(lw p) THEN !== current time step ==! ("time.step" file)101 IF(lwm) THEN !== current time step ==! ("time.step" file) 92 102 WRITE ( numstp, '(1x, i8)' ) kt 93 103 REWIND( numstp ) … … 101 111 ENDIF 102 112 zmax(2) = MAXVAL( ABS( un(:,:,:) ) ) ! velocity max (zonal only) 103 !zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max104 zmax( 3) = 0.0_wp105 zmax( 4) = REAL( nstop , wp ) ! stop indicator106 !107 IF( lk_mpp ) THEN108 CALL mpp_max_multiple( zmax(:), 4 ) ! max over the global domain109 !110 nstop = INT( zmax(4) ) ! nstop indicator sheared among all local domains113 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 111 121 ENDIF 112 122 ! 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 115 126 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) 157 130 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 158 131 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 160 140 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 161 141 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 162 142 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 163 187 ! 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) 188 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 189 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 190 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 191 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 192 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 166 193 ! 167 194 END SUBROUTINE stp_ctl -
NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90
r10074 r10425 92 92 END DO 93 93 !!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. ) 95 95 !!gm 96 96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90
r10074 r10425 169 169 END DO 170 170 END DO 171 CALL lbc_lnk( pssh, 'T', 1. )171 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 172 172 END DO 173 173 … … 293 293 pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 ) 294 294 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. ) 299 299 300 300 END SUBROUTINE usr_def_istate -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_zgr.F90
r10074 r10425 198 198 CASE(1) 199 199 zmaxlam = MAXVAL(glamt) 200 IF( lk_mpp ) CALL mpp_max(zmaxlam ) ! max over the global domain200 CALL mpp_max( 'usrdef_zgr', zmaxlam ) ! max over the global domain 201 201 zscl = rpi / zmaxlam 202 202 z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ) ) … … 204 204 END SELECT 205 205 ! 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) 207 207 ! 208 208 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_nosignedzero1 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_iomput1 bld::tool::fppkeys key_agrif key_si3 key_mpp_mpi key_iomput -
NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
r10074 r10425 89 89 ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 90 90 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) 92 92 zmsk(:,:) = NINT( z2d(:,:) ) 93 93 ! … … 177 177 END DO 178 178 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 ) 181 181 DO jk = 1, jpk 182 182 ! 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_nosignedzero1 bld::tool::fppkeys key_iomput key_mpp_mpi -
NEMO/trunk/tests/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90
r10074 r10425 88 88 ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 89 89 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) 91 91 k_top(:,:) = NINT( z2d(:,:) ) 92 92 ! -
NEMO/trunk/tests/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm
r9139 r10425 1 bld::tool::fppkeys key_iomput key_mpp_mpi key_nosignedzero1 bld::tool::fppkeys key_iomput key_mpp_mpi -
NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
r10074 r10425 93 93 zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) 94 94 END DO 95 CALL lbc_lnk( zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points95 CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points 96 96 ! ! ==>>> set by hand non-zero value on first/last columns & rows 97 97 DO ji = mi0(1), mi1(1) ! first row of global domain only … … 112 112 ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 113 113 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) 115 115 k_top(:,:) = NINT( z2d(:,:) ) 116 116 ! -
NEMO/trunk/tests/OVERFLOW/cpp_OVERFLOW.fcm
r9139 r10425 1 bld::tool::fppkeys key_mpp_mpi key_iomput key_nosignedzero1 bld::tool::fppkeys key_mpp_mpi key_iomput -
NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90
r10074 r10425 79 79 & dtilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & 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' ) 83 83 un_td = 0._wp 84 84 vn_td = 0._wp … … 86 86 IF( ln_vvl_ztilde ) THEN 87 87 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' ) 90 90 ENDIF 91 91 ! … … 234 234 END DO 235 235 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 241 243 ENDIF 242 244 ENDIF … … 408 410 ! ! d - thickness diffusion transport: boundary conditions 409 411 ! (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) 411 413 412 414 ! 4 - Time stepping of baroclinic scale factors … … 419 421 z2dt = 2.0_wp * rdt 420 422 ENDIF 421 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )423 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 422 424 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 423 425 … … 429 431 END DO 430 432 z_tmax = MAXVAL( ze3t(:,:,:) ) 431 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain433 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 432 434 z_tmin = MINVAL( ze3t(:,:,:) ) 433 IF( lk_mpp ) CALL mpp_min(z_tmin ) ! min over the global domain435 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 434 436 ! - ML - test: for the moment, stop simulation for too large e3_t variations 435 437 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 436 438 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 ) 439 441 ELSE 440 442 ijk_max = MAXLOC( ze3t(:,:,:) ) … … 450 452 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 451 453 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') 453 455 ENDIF 454 456 ENDIF … … 493 495 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 494 496 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 495 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain497 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 496 498 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 497 499 END IF … … 502 504 END DO 503 505 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 domain506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 505 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 506 508 ! … … 510 512 END DO 511 513 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 domain514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 513 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 514 516 ! … … 518 520 END DO 519 521 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 domain522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 521 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 522 524 ! 523 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 524 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 525 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 526 528 ! 527 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 528 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 529 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 530 532 ! 531 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 532 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 533 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 534 536 END IF … … 711 713 END DO 712 714 END DO 713 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )715 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 714 716 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 715 717 ! … … 724 726 END DO 725 727 END DO 726 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 727 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 728 730 ! … … 738 740 END DO 739 741 END DO 740 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )742 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 741 743 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 742 744 ! -
NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_istate.F90
r10074 r10425 136 136 END DO 137 137 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. ) 140 140 ! 141 141 END SUBROUTINE usr_def_istate -
NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_zgr.F90
r10074 r10425 192 192 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 193 193 ! 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) 195 195 ! 196 196 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_agrif1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif -
NEMO/trunk/tests/WAD/MY_SRC/bdyini.F90
r10074 r10425 1133 1133 END DO 1134 1134 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. 1136 1136 1137 1137 ! bdy masks are now set to zero on boundary points: … … 1169 1169 1170 1170 ! 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. ) 1173 1173 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1174 1174 … … 1280 1280 END DO 1281 1281 ! 1282 IF( lk_mpp ) CALL mpp_sum(bdysurftot ) ! sum over the global domain1282 CALL mpp_sum( 'bdyini', bdysurftot ) ! sum over the global domain 1283 1283 END IF 1284 1284 ! … … 1520 1520 END DO 1521 1521 END DO 1522 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1522 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1523 1523 1524 1524 IF (ztestmask(1)==1) THEN … … 1564 1564 END DO 1565 1565 END DO 1566 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1566 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1567 1567 1568 1568 IF (ztestmask(1)==1) THEN … … 1608 1608 END DO 1609 1609 END DO 1610 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1610 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1611 1611 1612 1612 IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN … … 1638 1638 END DO 1639 1639 END DO 1640 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1640 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1641 1641 1642 1642 IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_zgr.F90
r10074 r10425 234 234 zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) 235 235 END DO 236 CALL lbc_lnk( zhu, 'U', 1. ) ! boundary condition: this mask the surrounding grid-points236 CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrounding grid-points 237 237 ! ! ==>>> set by hand non-zero value on first/last columns & rows 238 238 DO ji = mi0(1), mi1(1) ! first row of global domain only … … 247 247 zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) ) 248 248 END DO 249 CALL lbc_lnk( zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points249 CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points 250 250 DO jj = mj0(1), mj1(1) ! first row of global domain only 251 251 zhv(:,jj) = zht(:,jj) … … 272 272 273 273 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) 275 275 k_top(:,:) = NINT( z2d(:,:) ) 276 276 ! … … 311 311 END DO 312 312 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. ) 322 322 WHERE( pe3t (:,:,:) == 0._wp ) pe3t (:,:,:) = 1._wp 323 323 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_nosignedzero1 bld::tool::fppkeys key_iomput key_mpp_mpi -
NEMO/trunk/tests/demo_cfgs.txt
r10413 r10425 7 7 VORTEX OCE NST 8 8 WAD OCE 9 9 BENCH OCE ICE TOP
Note: See TracChangeset
for help on using the changeset viewer.