Changeset 9925 for NEMO/trunk/tests/WAD/MY_SRC
- Timestamp:
- 2018-07-11T13:47:37+02:00 (6 years ago)
- Location:
- NEMO/trunk/tests/WAD/MY_SRC
- Files:
-
- 1 deleted
- 5 edited
-
bdyini.F90 (modified) (17 diffs)
-
domain.F90 (deleted)
-
usrdef_hgr.F90 (modified) (2 diffs)
-
usrdef_istate.F90 (modified) (2 diffs)
-
usrdef_nam.F90 (modified) (2 diffs)
-
usrdef_zgr.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/WAD/MY_SRC/bdyini.F90
r9659 r9925 44 44 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn ! 45 45 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs ! 46 47 46 !!---------------------------------------------------------------------- 48 !! NEMO/O PA 3.7 , NEMO Consortium (2015)49 !! $Id: bdyini.F90 7421 2016-12-01 17:10:41Z flavoni$50 !! Software governed by the CeCILL licence ( NEMOGCM/NEMO_CeCILL.txt)47 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 48 !! $Id: bdyini.F90 9807 2018-06-15 22:51:16Z lovato $ 49 !! Software governed by the CeCILL licence (./LICENSE) 51 50 !!---------------------------------------------------------------------- 52 51 CONTAINS … … 86 85 IF(lwm) WRITE ( numond, nambdy ) 87 86 87 IF( .NOT. Agrif_Root() ) ln_bdy = .FALSE. ! forced for Agrif children 88 88 89 ! ----------------------------------------- 89 90 ! unstructured open boundaries use control … … 112 113 END SUBROUTINE bdy_init 113 114 114 115 115 116 SUBROUTINE bdy_segs 116 117 !!---------------------------------------------------------------------- … … 124 125 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 125 126 !!---------------------------------------------------------------------- 126 127 ! local variables128 !-------------------129 127 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 130 128 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers … … 146 144 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 147 145 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 148 REAL(wp), DIMENSION(jpi,jpj):: zfmask ! temporary fmask array excluding coastal boundary condition (shlat)146 REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 149 147 !! 150 148 CHARACTER(LEN=1) :: ctypebdy ! - - … … 345 343 346 344 #if defined key_si3 347 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: '348 SELECT CASE( cn_ice(ib_bdy) )349 345 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 346 SELECT CASE( cn_ice(ib_bdy) ) 347 CASE('none') 350 348 IF(lwp) WRITE(numout,*) ' no open boundary condition' 351 dta_bdy(ib_bdy)%ll_a_i 352 dta_bdy(ib_bdy)%ll_h t_i = .false.353 dta_bdy(ib_bdy)%ll_h t_s = .false.354 349 dta_bdy(ib_bdy)%ll_a_i = .false. 350 dta_bdy(ib_bdy)%ll_h_i = .false. 351 dta_bdy(ib_bdy)%ll_h_s = .false. 352 CASE('frs') 355 353 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 356 dta_bdy(ib_bdy)%ll_a_i 357 dta_bdy(ib_bdy)%ll_h t_i = .true.358 dta_bdy(ib_bdy)%ll_h t_s = .true.359 360 END SELECT354 dta_bdy(ib_bdy)%ll_a_i = .true. 355 dta_bdy(ib_bdy)%ll_h_i = .true. 356 dta_bdy(ib_bdy)%ll_h_s = .true. 357 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice' ) 358 END SELECT 361 359 IF( cn_ice(ib_bdy) /= 'none' ) THEN 362 360 SELECT CASE( nn_ice_dta(ib_bdy) ) ! … … 374 372 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 375 373 IF(lwp) WRITE(numout,*) 376 377 END DO378 379 IF (nb_bdy .gt. 0) THEN374 ! 375 END DO 376 377 IF( nb_bdy > 0 ) THEN 380 378 IF( ln_vol ) THEN ! check volume conservation (nn_volctl value) 381 379 IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' … … 417 415 418 416 DO ib_bdy = 1, nb_bdy 419 ! 417 420 418 IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters 421 !419 422 420 icount = icount + 1 423 421 ! No REWIND here because may need to read more than one nambdy_index namelist. … … 494 492 DO igrd = 1, jpbgrd 495 493 id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz ) 496 !clem nblendta(igrd,ib_bdy) = kdimsz(1)497 !clem jpbdtau = MAX(jpbdtau, kdimsz(1))498 494 nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 499 495 jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) … … 885 881 IF( nbrdta(ib,igrd,ib_bdy) == 1 ) icountr = icountr+1 886 882 ENDIF 887 END DO883 END DO 888 884 idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 889 885 idx_bdy(ib_bdy)%nblen (igrd) = icount !: length of boundary data on each proc 890 END DO ! igrd886 END DO ! igrd 891 887 892 888 ! Allocate index arrays for this boundary set 893 889 !-------------------------------------------- 894 890 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 895 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) )896 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) )897 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) )898 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) )899 ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) )900 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )901 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) )902 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )903 ALLOCATE(idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )891 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) , & 892 & idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) , & 893 & idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) , & 894 & idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) , & 895 & idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) , & 896 & idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) , & 897 & idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) , & 898 & idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) , & 899 & idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 904 900 905 901 ! Dispatch mapping indices and discrete distances on each processor … … 1114 1110 END DO 1115 1111 1116 END DO1112 END DO 1117 1113 1118 1114 ! ------------------------------------------------------ … … 1127 1123 bdytmask(:,:) = ssmask(:,:) 1128 1124 1129 IF( ln_mask_file ) THEN 1130 CALL iom_open( cn_mask_file, inum ) 1131 CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 1132 CALL iom_close( inum ) 1133 1134 ! Derive mask on U and V grid from mask on T grid 1135 bdyumask(:,:) = 0._wp 1136 bdyvmask(:,:) = 0._wp 1137 DO ij=1, jpjm1 1138 DO ii=1, jpim1 1139 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1140 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1141 END DO 1125 ! Derive mask on U and V grid from mask on T grid 1126 1127 bdyumask(:,:) = 0._wp 1128 bdyvmask(:,:) = 0._wp 1129 DO ij = 1, jpjm1 1130 DO ii = 1, jpim1 1131 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1132 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1142 1133 END DO 1143 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 1144 1145 ENDIF ! ln_mask_file=.TRUE. 1146 1147 IF( .NOT.ln_mask_file ) THEN 1148 ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 1149 bdyumask(:,:) = 0._wp 1150 bdyvmask(:,:) = 0._wp 1151 DO ij = 1, jpjm1 1152 DO ii = 1, jpim1 1153 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1154 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1155 END DO 1156 END DO 1157 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 1158 ENDIF 1134 END DO 1135 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond. 1159 1136 1160 1137 ! bdy masks are now set to zero on boundary points: … … 1178 1155 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1179 1156 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1180 END DO1181 END DO1157 END DO 1158 END DO 1182 1159 1183 1160 ! For the flagu/flagv calculation below we require a version of fmask without 1184 1161 ! the land boundary condition (shlat) included: 1162 zfmask(:,:) = 0 1185 1163 DO ij = 2, jpjm1 1186 1164 DO ii = 2, jpim1 … … 1191 1169 1192 1170 ! Lateral boundary conditions 1193 CALL lbc_lnk( zfmask , 'F', 1. ) 1194 CALL lbc_lnk( fmask , 'F', 1. ) ; CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 1195 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 1196 1171 CALL lbc_lnk( zfmask, 'F', 1. ) 1172 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 1197 1173 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1198 1174 … … 1206 1182 ! flagu = 1 : u is normal to the boundary and is direction is inward 1207 1183 1208 DO igrd = 1, jpbgrd1184 DO igrd = 1, jpbgrd 1209 1185 SELECT CASE( igrd ) 1210 1186 CASE( 1 ) ; pmask => umask (:,:,1) ; i_offset = 0 … … 1310 1286 !-------- 1311 1287 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1312 !1313 1288 ! 1314 1289 END SUBROUTINE bdy_segs … … 1690 1665 END SUBROUTINE bdy_ctl_seg 1691 1666 1667 1692 1668 SUBROUTINE bdy_ctl_corn( ib1, ib2 ) 1693 1669 !!---------------------------------------------------------------------- -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_hgr.F90
r9124 r9925 7 7 !! User defined : mesh and Coriolis parameter of a user configuration 8 8 !!====================================================================== 9 !! History : NEMO ! 2016-08 (S. Flavoni, G. Madec) Original code9 !! History : 4.0 ! 2016-03 (S. Flavoni) 10 10 !!---------------------------------------------------------------------- 11 11 … … 27 27 28 28 !!---------------------------------------------------------------------- 29 !! NEMO/O PA 4.0 , NEMO Consortium (2016)30 !! $Id $31 !! Software governed by the CeCILL licence ( NEMOGCM/NEMO_CeCILL.txt)29 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 30 !! $Id:$ 31 !! Software governed by the CeCILL licence (./LICENSE) 32 32 !!---------------------------------------------------------------------- 33 33 CONTAINS -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_istate.F90
r9024 r9925 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 10 !!---------------------------------------------------------------------- 11 11 … … 24 24 PRIVATE 25 25 26 PUBLIC usr_def_istate ! called byistate.F9026 PUBLIC usr_def_istate ! called in istate.F90 27 27 28 28 !!---------------------------------------------------------------------- 29 !! NEMO/O PA 4.0 , NEMO Consortium (2016)30 !! $Id $31 !! Software governed by the CeCILL licence ( NEMOGCM/NEMO_CeCILL.txt)29 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 30 !! $Id:$ 31 !! Software governed by the CeCILL licence (./LICENSE) 32 32 !!---------------------------------------------------------------------- 33 33 CONTAINS -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_nam.F90
r7616 r9925 7 7 !! User defined : set the domain characteristics of a user configuration 8 8 !!====================================================================== 9 !! History : NEMO! 2016-03 (S. Flavoni, G. Madec) Original code9 !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) Original code 10 10 !!---------------------------------------------------------------------- 11 11 … … 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/O PA 4.0 , NEMO Consortium (2016)36 !! $Id $37 !! Software governed by the CeCILL licence ( NEMOGCM/NEMO_CeCILL.txt)35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 36 !! $Id:$ 37 !! Software governed by the CeCILL licence (./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_zgr.F90
r9135 r9925 7 7 !! Ocean domain : user defined vertical coordinate system 8 8 !!====================================================================== 9 !! History : 4.0 ! 2016-0 8 (G. Madec, S. Flavoni) Original code9 !! History : 4.0 ! 2016-06 (G. Madec) Original code 10 10 !!---------------------------------------------------------------------- 11 11 12 12 !!---------------------------------------------------------------------- 13 13 !! usr_def_zgr : user defined vertical coordinate system (required) 14 !! zgr_z 1d: reference 1D z-coordinate14 !! zgr_z : reference 1D z-coordinate 15 15 !!--------------------------------------------------------------------- 16 16 USE oce ! ocean variables … … 27 27 PRIVATE 28 28 29 PUBLIC usr_def_zgr ! called by domzgr.F9030 31 !! * Substitutions29 PUBLIC usr_def_zgr ! called by domzgr.F90 30 31 !! * Substitutions 32 32 # include "vectopt_loop_substitute.h90" 33 33 !!---------------------------------------------------------------------- 34 !! NEMO/O PA 4.0 , NEMO Consortium (2016)35 !! $Id $36 !! Software governed by the CeCILL licence ( NEMOGCM/NEMO_CeCILL.txt)34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 35 !! $Id:$ 36 !! Software governed by the CeCILL licence (./LICENSE) 37 37 !!---------------------------------------------------------------------- 38 38 CONTAINS … … 41 41 & pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate 42 42 & pdept , pdepw , & ! 3D t & w-points depth 43 & pe3t , pe3u , pe3v , pe3f ,& ! vertical scale factors44 & pe3w , pe3uw , pe3vw ,& ! - - -43 & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors 44 & pe3w , pe3uw , pe3vw , & ! - - - 45 45 & k_top , k_bot ) ! top & bottom ocean level 46 46 !!--------------------------------------------------------------------- … … 255 255 END DO 256 256 ! 257 CALL zgr_z 1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! Reference z-coordinate system257 CALL zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! Reference z-coordinate system 258 258 ! 259 259 ! … … 334 334 335 335 336 SUBROUTINE zgr_z 1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! 1D reference vertical coordinate337 !!---------------------------------------------------------------------- 338 !! *** ROUTINE zgr_z 1d***336 SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! 1D reference vertical coordinate 337 !!---------------------------------------------------------------------- 338 !! *** ROUTINE zgr_z *** 339 339 !! 340 340 !! ** Purpose : set the depth of model levels and the resulting … … 363 363 IF(lwp) THEN ! Parameter print 364 364 WRITE(numout,*) 365 WRITE(numout,*) ' zgr_z 1d: Reference vertical z-coordinates: uniform dz = ', rn_dz365 WRITE(numout,*) ' zgr_z : Reference vertical z-coordinates: uniform dz = ', rn_dz 366 366 WRITE(numout,*) ' ~~~~~~~' 367 367 ENDIF … … 385 385 ENDIF 386 386 ! 387 END SUBROUTINE zgr_z 1d387 END SUBROUTINE zgr_z 388 388 389 389 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
