Changeset 13369 for utils/tools/SIREN/src/create_meshmask.f90
- Timestamp:
- 2020-07-31T10:50:52+02:00 (4 years ago)
- File:
-
- 1 edited
-
utils/tools/SIREN/src/create_meshmask.f90 (modified) (70 diffs)
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/SIREN/src/create_meshmask.f90
r12080 r13369 14 14 !> @section sec1 method 15 15 !> bathymetry (and optionally ice shelf draft) is read on input file.<br/> 16 !> horizontal grid-point position, scale factors, and the coriolis factor 17 !> are read in coordinates file or computed.<br/> 16 !> horizontal grid-point position, scale factors, and the coriolis factor 17 !> are read in coordinates file or computed.<br/> 18 18 !> vertical coordinate is defined, and the bathymetry recomputed to fit the 19 19 !> vertical grid.<br/> … … 22 22 !> all the variables read and or computed, are writen in one to three file(s) depending on 23 23 !> output option. 24 !> @note 24 !> @note 25 25 !> the file contain depends on 26 26 !> the vertical coordinate used (z-coord, partial steps, s-coord) … … 60 60 !> 61 61 !> here after, each sub-namelist parameters is detailed. 62 !> @note 62 !> @note 63 63 !> default values are specified between brackets 64 64 !> … … 79 79 !> - none 80 80 !> 81 !> - **in_maxerror** [@a 5]<br/> 81 !> - **in_maxerror** [@a 5]<br/> 82 82 !> maximum number of error allowed 83 83 !> … … 87 87 !> - **cn_varcfg** [@a ./cfg/variable.cfg]<br/> 88 88 !> path to the variable configuration file.<br/> 89 !> the variable configuration file defines standard name, 90 !> default interpolation method, axis,... 91 !> to be used for some known variables.<br/> 92 !> 93 !> - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 94 !> path to the dimension configuration file.<br/> 95 !> the dimension configuration file defines dimensions allowed.<br/> 96 !> 97 !> - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 89 !> the variable configuration file defines standard name, 90 !> default interpolation method, axis,... 91 !> to be used for some known variables.<br/> 92 !> 93 !> - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 94 !> path to the dimension configuration file.<br/> 95 !> the dimension configuration file defines dimensions allowed.<br/> 96 !> 97 !> - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 98 98 !> path to the useless (dummy) configuration file.<br/> 99 !> the dummy configuration file defines useless 99 !> the dummy configuration file defines useless 100 100 !> dimension or variable. these dimension(s) or variable(s) will not be 101 101 !> processed.<br/> 102 102 !> 103 !> @subsection subsrc namsrc 103 !> @subsection subsrc namsrc 104 104 !> the source grid sub-namelist parameters are : 105 105 !> … … 204 204 !> double tanh function parameter 205 205 !> 206 !> @note 206 !> @note 207 207 !> If *dn_ppa1*, *dn_ppa0* and *dn_ppsur* are undefined, 208 208 !> NEMO will compute them from *dn_ppdzmin, dn_pphmax, dn_ppkth, dn_ppacr* … … 266 266 !> lateral boundary conditions at the coast (modify fmask) 267 267 !> - shlat = 0 : free slip 268 !> - 0 < shlat < 2 : partial slip 268 !> - 0 < shlat < 2 : partial slip 269 269 !> - shlat = 2 : no slip 270 270 !> - shlat > 2 : strong slip 271 271 !> 272 !> for more information see Boundary Condition at the Coast 272 !> for more information see Boundary Condition at the Coast 273 273 !> in [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf) 274 274 !> … … 312 312 !> - if niproc, and njproc are provided : the program only look for land 313 313 !> processor to be removed 314 !> - if nproc is provided : the program compute each possible domain layout, 315 !> and save the one with the most land processor to be removed 314 !> - if nproc is provided : the program compute each possible domain layout, 315 !> and save the one with the most land processor to be removed 316 316 !> - with no information about number of processors, the program 317 317 !> assume to use only one processor … … 326 326 !> @note 327 327 !> - if 0 < in_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 328 !> - if 3 < in_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 328 !> - if 3 < in_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 329 329 !> corresponding to the depth of the bottom t- and w-points 330 330 !> - if 6 < in_msh <= 9: write 2D arrays corresponding to the depth and the … … 405 405 406 406 TYPE(TDIM) :: tl_dim 407 407 408 408 TYPE(TVAR) :: tl_bathy 409 409 TYPE(TVAR) :: tl_risfdep … … 438 438 ! namelist variable 439 439 ! namlog 440 CHARACTER(LEN=lc) :: cn_logfile = 'create_meshmask.log' 441 CHARACTER(LEN=lc) :: cn_verbosity= 'warning' 440 CHARACTER(LEN=lc) :: cn_logfile = 'create_meshmask.log' 441 CHARACTER(LEN=lc) :: cn_verbosity= 'warning' 442 442 INTEGER(i4) :: in_maxerror = 5 443 443 444 444 ! namcfg 445 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 445 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 446 446 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 447 447 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' … … 470 470 ! namout 471 471 CHARACTER(LEN=lc) :: cn_domcfg = 'domain_cfg.nc' 472 INTEGER(i4) :: in_msh = 0 472 INTEGER(i4) :: in_msh = 0 473 473 CHARACTER(LEN=lc) :: cn_type = 'cdf' 474 474 INTEGER(i4) :: in_nproc = 0 … … 513 513 & in_niproc, & !< i-direction number of processor 514 514 & in_njproc !< j-direction numebr of processor 515 !------------------------------------------------------------------- 515 !------------------------------------------------------------------- 516 516 517 517 ! … … 525 525 IF( il_narg /= 1 )THEN 526 526 WRITE(cl_errormsg,*) ' ERROR : one argument is needed ' 527 CALL fct_help(cp_myname,cl_errormsg) 527 CALL fct_help(cp_myname,cl_errormsg) 528 528 CALL EXIT(1) 529 529 ELSE … … 560 560 IF( il_status /= 0 )THEN 561 561 WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist) 562 CALL fct_help(cp_myname,cl_errormsg) 562 CALL fct_help(cp_myname,cl_errormsg) 563 563 CALL EXIT(1) 564 564 ENDIF 565 565 566 566 READ( il_fileid, NML = namlog ) 567 567 568 568 ! define logger file 569 569 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) … … 599 599 600 600 WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist) 601 CALL fct_help(cp_myname,cl_errormsg) 601 CALL fct_help(cp_myname,cl_errormsg) 602 602 CALL EXIT(1) 603 603 … … 618 618 ELSE 619 619 CALL logger_fatal("CREATE MESH MASK: no input bathymetry file found. "//& 620 & "check namelist") 620 & "check namelist") 621 621 ENDIF 622 622 … … 652 652 tl_bathy%d_value(:,:,1,1) = 0._dp 653 653 END WHERE 654 654 655 655 IF ( ln_isfcav ) THEN 656 656 WRITE(*,*) 'ICESHELF DRAFT FILE TO BE USED:',TRIM(cn_isfdep) … … 662 662 ELSE 663 663 CALL logger_fatal("CREATE MESH MASK: no input Iceshelf draft '//& 664 & 'file found. check namelist") 664 & 'file found. check namelist") 665 665 ENDIF 666 666 … … 709 709 ! compute horizontal mesh 710 710 WRITE(*,*) "COMPUTE HORIZONTAL MESH" 711 CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg) 711 CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg) 712 712 713 713 ! Vertyical mesh (dom_zgr) ------------------------------------------------- … … 717 717 CALL grid_zgr_init(jpi,jpj,jpk,ln_sco) 718 718 IF( ln_zps ) CALL grid_zgr_zps_init(jpi,jpj) 719 IF( ln_sco ) CALL grid_zgr_sco_init(jpi,jpj) 719 IF( ln_sco ) CALL grid_zgr_sco_init(jpi,jpj) 720 720 721 721 ! compute vertical mesh … … 729 729 ! Maximum stiffness ratio/hydrostatic consistency 730 730 IF( ln_sco ) CALL grid_zgr_sco_stiff(tl_namz,jpi,jpj,jpk) 731 731 732 732 ! clean 733 733 CALL var_clean(tl_bathy) 734 734 735 735 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 736 ! create ouptut structure 736 ! create ouptut structure 737 737 IF( in_niproc == 0 .AND. & 738 738 & in_njproc == 0 .AND. & … … 768 768 tl_mpphgr=>tl_mppout0 769 769 tl_mppzgr=>tl_mppout0 770 770 771 771 ! ! ============================ 772 CASE ( 2 ) ! create 'mesh.nc' and 772 CASE ( 2 ) ! create 'mesh.nc' and 773 773 ! ! 'mask.nc' files 774 774 ! ! ============================ … … 823 823 tl_scalar=var_init('jpkglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) 824 824 CALL mpp_add_var(tl_mppmsk, tl_scalar) 825 825 826 826 il_tmp(:)=tl_mppout0%i_perio 827 827 tl_scalar=var_init('jperio', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) … … 953 953 CALL mpp_add_var(tl_mpphgr, tg_gcosf) 954 954 CALL var_clean(tg_gcosf) 955 955 956 956 ! sint 957 957 CALL mpp_add_var(tl_mpphgr, tg_gsint) … … 967 967 CALL var_clean(tg_gsinf) 968 968 ENDIF 969 969 970 970 !!! vertical mesh (zgr) 971 971 !!!---------------------- 972 972 ! note that mbkt is set to 1 over land ==> use surface tmask 973 ! 973 ! 974 974 ! mbathy 975 975 tg_mbathy%d_value(:,:,:,:) = tg_ssmask%d_value(:,:,:,:) * & … … 1000 1000 tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * & 1001 1001 & tg_mikt%d_value(:,:,:,:) 1002 1002 1003 1003 CALL mpp_add_var(tl_mppzgr, tl_risfdep) 1004 1004 CALL var_clean(tl_risfdep) … … 1078 1078 CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d) 1079 1079 CALL var_clean(tg_gdepw_1d) 1080 1080 1081 1081 ! gdept_0 1082 CALL mpp_add_var(tl_mppzgr, tg_gdept_0) 1082 CALL mpp_add_var(tl_mppzgr, tg_gdept_0) 1083 1083 CALL var_clean(tg_gdept_0) 1084 1084 ! gdepw_0 1085 CALL mpp_add_var(tl_mppzgr, tg_gdepw_0) 1085 CALL mpp_add_var(tl_mppzgr, tg_gdepw_0) 1086 1086 CALL var_clean(tg_gdepw_0) 1087 1087 ENDIF … … 1108 1108 ELSE 1109 1109 1110 DO jj = 1,jpj 1110 DO jj = 1,jpj 1111 1111 DO ji = 1,jpi 1112 1112 ik=tg_mbkt%d_value(ji,jj,1,1) … … 1116 1116 & tg_ssmask%d_value(ji,jj,1,1) 1117 1117 END DO 1118 END DO 1118 END DO 1119 1119 ! e3t_ps 1120 1120 CALL mpp_add_var(tl_mppzgr, tg_e3tp) … … 1127 1127 1128 1128 IF( ll_domcfg .OR. in_msh <= 3 ) THEN ! 3D depth 1129 1129 1130 1130 IF( .NOT. tl_namz%l_e3_dep )THEN 1131 1131 1132 1132 ! gdepu, gdepv 1133 1133 IF( .NOT. ll_domcfg )THEN … … 1139 1139 1140 1140 DEALLOCATE(dl_tmp3D) 1141 DO jk = 1,jpk 1142 DO jj = 1, jpj-1 1141 DO jk = 1,jpk 1142 DO jj = 1, jpj-1 1143 1143 DO ji = 1, jpi-1 ! vector opt. 1144 1144 tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & … … 1147 1147 tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & 1148 1148 & tg_gdept_0%d_value(ji ,jj+1,jk,1) ) 1149 END DO 1150 END DO 1151 END DO 1149 END DO 1150 END DO 1151 END DO 1152 1152 CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp ) 1153 1153 CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp ) … … 1178 1178 1179 1179 DEALLOCATE(dl_tmp2D) 1180 DO jj = 1,jpj 1180 DO jj = 1,jpj 1181 1181 DO ji = 1,jpi 1182 1182 ik=tg_mbkt%d_value(ji,jj,1,1) … … 1209 1209 ENDIF 1210 1210 1211 IF( ln_zps .OR. ln_zco )THEN ! z-coordinate 1211 IF( ln_zps .OR. ln_zco )THEN ! z-coordinate 1212 1212 IF( .NOT. tl_namz%l_e3_dep )THEN 1213 1213 ! depth … … 1233 1233 tl_att=att_init("Created_by","SIREN create_meshmask") 1234 1234 CALL mpp_add_att(tl_mppmsk, tl_att) 1235 1235 1236 1236 !add source url 1237 1237 cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:') … … 1243 1243 tl_att=att_init("Creation_date",TRIM(cl_date)) 1244 1244 CALL mpp_add_att(tl_mppmsk, tl_att) 1245 1245 1246 1246 ! add attribute periodicity 1247 1247 il_attid=0 … … 1253 1253 CALL mpp_add_att(tl_mppmsk,tl_att) 1254 1254 ENDIF 1255 1255 1256 1256 il_attid=0 1257 1257 IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN … … 1262 1262 CALL mpp_add_att(tl_mppmsk,tl_att) 1263 1263 ENDIF 1264 1264 1265 1265 ji=1 1266 1266 DO WHILE( tl_gatt(ji)%c_name /= '' ) … … 1271 1271 ! create file 1272 1272 CALL iom_mpp_create(tl_mppmsk) 1273 1273 1274 1274 ! write file 1275 1275 CALL iom_mpp_write_file(tl_mppmsk) 1276 1276 ! close file 1277 1277 CALL iom_mpp_close(tl_mppmsk) 1278 1278 1279 1279 ! clean 1280 1280 CALL mpp_clean(tl_mppmsk) … … 1285 1285 CALL mpp_add_att(tl_mppmsk, tl_att) 1286 1286 CALL mpp_add_att(tl_mpphgr, tl_att) 1287 1287 1288 1288 !add source url 1289 1289 cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:') … … 1297 1297 CALL mpp_add_att(tl_mppmsk, tl_att) 1298 1298 CALL mpp_add_att(tl_mpphgr, tl_att) 1299 1299 1300 1300 ! add attribute periodicity 1301 1301 il_attid=0 … … 1308 1308 CALL mpp_add_att(tl_mpphgr,tl_att) 1309 1309 ENDIF 1310 1310 1311 1311 il_attid=0 1312 1312 IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN … … 1325 1325 ji=ji+1 1326 1326 ENDDO 1327 1327 1328 1328 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1329 1329 ! create mask file 1330 1330 !----------------- 1331 1331 CALL iom_mpp_create(tl_mppmsk) 1332 1332 1333 1333 ! write file 1334 1334 CALL iom_mpp_write_file(tl_mppmsk) 1335 1335 ! close file 1336 1336 CALL iom_mpp_close(tl_mppmsk) 1337 1337 1338 1338 ! clean 1339 1339 CALL mpp_clean(tl_mppmsk) … … 1342 1342 !----------------- 1343 1343 CALL iom_mpp_create(tl_mpphgr) 1344 1344 1345 1345 ! write file 1346 1346 CALL iom_mpp_write_file(tl_mpphgr) 1347 1347 ! close file 1348 1348 CALL iom_mpp_close(tl_mpphgr) 1349 1349 1350 1350 ! clean 1351 1351 CALL mpp_clean(tl_mpphgr) … … 1357 1357 CALL mpp_add_att(tl_mpphgr, tl_att) 1358 1358 CALL mpp_add_att(tl_mppzgr, tl_att) 1359 1359 1360 1360 !add source url 1361 1361 cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:') … … 1371 1371 CALL mpp_add_att(tl_mpphgr, tl_att) 1372 1372 CALL mpp_add_att(tl_mppzgr, tl_att) 1373 1373 1374 1374 ! add attribute periodicity 1375 1375 il_attid=0 … … 1383 1383 CALL mpp_add_att(tl_mppzgr,tl_att) 1384 1384 ENDIF 1385 1385 1386 1386 il_attid=0 1387 1387 IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN … … 1407 1407 !----------------- 1408 1408 CALL iom_mpp_create(tl_mppmsk) 1409 1409 1410 1410 ! write file 1411 1411 CALL iom_mpp_write_file(tl_mppmsk) 1412 1412 ! close file 1413 1413 CALL iom_mpp_close(tl_mppmsk) 1414 1414 1415 1415 ! clean 1416 1416 WRITE(*,*) "CLEAN MSK" … … 1420 1420 !----------------- 1421 1421 CALL iom_mpp_create(tl_mpphgr) 1422 1422 1423 1423 ! write file 1424 1424 CALL iom_mpp_write_file(tl_mpphgr) 1425 1425 ! close file 1426 1426 CALL iom_mpp_close(tl_mpphgr) 1427 1427 1428 1428 ! clean 1429 1429 WRITE(*,*) "CLEAN HGR" … … 1434 1434 WRITE(*,*) "CREATE ZGR" 1435 1435 CALL iom_mpp_create(tl_mppzgr) 1436 1436 1437 1437 ! write file 1438 1438 WRITE(*,*) "WRITE ZGR" … … 1441 1441 WRITE(*,*) "CLOSE ZGR" 1442 1442 CALL iom_mpp_close(tl_mppzgr) 1443 1443 1444 1444 ! clean 1445 1445 WRITE(*,*) "CLEAN ZGR" … … 1469 1469 CONTAINS 1470 1470 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1471 SUBROUTINE create_meshmask__mask(td_nam,jpi,jpj,jpk,ld_domcfg) 1471 SUBROUTINE create_meshmask__mask(td_nam,jpi,jpj,jpk,ld_domcfg) 1472 1472 !------------------------------------------------------------------- 1473 !> @brief This subroutine compute land/ocean mask arrays at tracer points, 1474 !> horizontal velocity points (u & v), vorticity points (f) and 1475 !> barotropic stream function points (b). 1473 !> @brief This subroutine compute land/ocean mask arrays at tracer points, 1474 !> horizontal velocity points (u & v), vorticity points (f) and 1475 !> barotropic stream function points (b). 1476 1476 !> 1477 1477 !> @details 1478 1478 !> 1479 !> ** Method : The ocean/land mask is computed from the basin bathymetry in level (mbathy) 1479 !> ** Method : The ocean/land mask is computed from the basin bathymetry in level (mbathy) 1480 1480 !> which is defined or read in dommba. 1481 1481 !> mbathy equals 0 over continental T-point and the number of ocean level over the ocean. 1482 1482 !> 1483 1483 !> At a given position (ji,jj,jk) the ocean/land mask is given by: 1484 !> - t-point : 1484 !> - t-point : 1485 1485 !> - 0. IF mbathy( ji ,jj) =< 0 1486 1486 !> - 1. IF mbathy( ji ,jj) >= jk 1487 !> - u-point : 1487 !> - u-point : 1488 1488 !> - 0. IF mbathy( ji ,jj) or mbathy(ji+1, jj ) =< 0 1489 1489 !> - 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 1490 !> - v-point : 1490 !> - v-point : 1491 1491 !> - 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) =< 0 1492 1492 !> - 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 1493 !> - f-point : 1493 !> - f-point : 1494 1494 !> - 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0 1495 1495 !> - 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. … … 1501 1501 !> 1502 1502 !> @warning do not set the lateral friction through the value of fmask along 1503 !> the coast and topography. 1503 !> the coast and topography. 1504 1504 !> 1505 1505 !> @note If nperio not equal to 0, the land/ocean mask arrays … … 1517 1517 !> - bmask is set to 0 on the open boundaries. 1518 1518 !> 1519 !> ** Action : 1519 !> ** Action : 1520 1520 !> - tmask : land/ocean mask at t-point (=0. or 1.) 1521 1521 !> - umask : land/ocean mask at u-point (=0. or 1.) … … 1539 1539 IMPLICIT NONE 1540 1540 1541 ! Argument 1541 ! Argument 1542 1542 TYPE(TNAMH), INTENT(IN) :: td_nam 1543 1543 INTEGER(i4), INTENT(IN) :: jpi … … 1588 1588 tg_tmask%d_value(ji,jj,jk,1) = 1._dp 1589 1589 ENDIF 1590 ENDDO 1591 ENDDO 1592 ENDDO 1593 1590 ENDDO 1591 ENDDO 1592 ENDDO 1593 1594 1594 ! (ISF) define barotropic mask and mask the ice shelf point 1595 1595 tg_ssmask%d_value(:,:,1,1)=tg_tmask%d_value(:,:,1,1) ! at this stage ice shelf is not masked 1596 1596 1597 1597 DO jk = 1, jpk 1598 1598 DO jj = 1, jpj … … 1601 1601 tg_tmask%d_value(ji,jj,jk,1) = 0._dp 1602 1602 END IF 1603 ENDDO 1604 ENDDO 1603 ENDDO 1604 ENDDO 1605 1605 ENDDO 1606 1606 … … 1618 1618 ! ! north fold mask 1619 1619 ! ! --------------- 1620 ! dl_tpol(1:jpi) = 1._dp 1620 ! dl_tpol(1:jpi) = 1._dp 1621 1621 ! dl_fpol(1:jpi) = 1._dp 1622 1622 ! IF( td_nam%i_perio == 3 .OR. td_nam%i_perio == 4 )THEN ! T-point pivot … … 1657 1657 ENDDO 1658 1658 ENDDO 1659 ENDDO 1659 ENDDO 1660 1660 1661 1661 ! ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point … … 1686 1686 ! CALL lbc_lnk( tg_ssfmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp ) 1687 1687 1688 ! 3. Ocean/land mask at wu-, wv- and w points 1688 ! 3. Ocean/land mask at wu-, wv- and w points 1689 1689 !---------------------------------------------- 1690 1690 ! tg_wmask%d_value (:,:,1,1) = tg_tmask%d_value(:,:,1,1) ! surface … … 1696 1696 ! & tg_tmask%d_value(:,:,jk-1,1) 1697 1697 ! tg_wumask%d_value(:,:,jk,1) = tg_umask%d_value(:,:,jk ,1) * & 1698 ! & tg_umask%d_value(:,:,jk-1,1) 1698 ! & tg_umask%d_value(:,:,jk-1,1) 1699 1699 ! tg_wvmask%d_value(:,:,jk,1) = tg_vmask%d_value(:,:,jk ,1) * & 1700 1700 ! & tg_vmask%d_value(:,:,jk-1,1) … … 1702 1702 1703 1703 ! Lateral boundary conditions on velocity (modify fmask) 1704 ! --------------------------------------- 1704 ! --------------------------------------- 1705 1705 IF( .NOT. ld_domcfg )THEN 1706 1706 ALLOCATE( zwf(jpi,jpj) ) 1707 1707 DO jk = 1, jpk 1708 zwf(:,:) = tg_fmask%d_value(:,:,jk,1) 1708 zwf(:,:) = tg_fmask%d_value(:,:,jk,1) 1709 1709 DO jj = 2, jpj-1 1710 1710 DO ji = 2, jpi-1 ! vector opt. … … 1725 1725 & MIN(1._wp, MAX(zwf(jpi,jj+1), zwf(jpi-1,jj), zwf(jpi,jj-1))) 1726 1726 ENDIF 1727 END DO 1727 END DO 1728 1728 DO ji = 2, jpi-1 1729 1729 IF( tg_fmask%d_value(ji,1,jk,1) == 0._dp )THEN … … 1744 1744 ! ! Gibraltar strait : partial slip (fmask=0.5) 1745 1745 ! ij0 = 101 ; ij1 = 101 1746 ! ii0 = 139 ; ii1 = 140 1746 ! ii0 = 139 ; ii1 = 140 1747 1747 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp 1748 1748 ! … … 1772 1772 ! isrow = 332 - jpj 1773 1773 ! ! Gibraltar Strait 1774 ! ii0 = 282 ; ii1 = 283 1774 ! ii0 = 282 ; ii1 = 283 1775 1775 ! ij0 = 201 + isrow ; ij1 = 241 - isrow 1776 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp 1776 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp 1777 1777 ! 1778 1778 ! ! Bhosporus Strait 1779 1779 ! ii0 = 314 ; ii1 = 315 1780 ! ij0 = 208 + isrow ; ij1 = 248 - isrow 1781 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1780 ! ij0 = 208 + isrow ; ij1 = 248 - isrow 1781 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1782 1782 ! 1783 ! ! Makassar Strait (Top) 1783 ! ! Makassar Strait (Top) 1784 1784 ! ii0 = 48 ; ii1 = 48 1785 1785 ! ij0 = 149 + isrow ; ij1 = 190 - isrow 1786 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1786 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1787 1787 ! 1788 1788 ! ! Lombok Strait 1789 1789 ! ii0 = 44 ; ii1 = 44 1790 1790 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1791 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1791 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1792 1792 ! 1793 1793 ! ! Ombai Strait 1794 1794 ! ii0 = 53 ; ii1 = 53 1795 1795 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1796 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1796 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1797 1797 ! 1798 1798 ! ! Timor Passage 1799 1799 ! ii0 = 56 ; ii1 = 56 1800 1800 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1801 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1801 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1802 1802 ! 1803 1803 ! ! West Halmahera Strait 1804 1804 ! ii0 = 58 ; ii1 = 58 1805 1805 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 1806 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1806 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1807 1807 ! 1808 1808 ! ! East Halmahera Strait 1809 1809 ! ii0 = 55 ; ii1 = 55 1810 1810 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 1811 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1811 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1812 1812 ! ! 1813 1813 ! ENDIF … … 1820 1820 ! DEALLOCATE( dl_tpol ) 1821 1821 ! DEALLOCATE( dl_fpol ) 1822 1822 1823 1823 END SUBROUTINE create_meshmask__mask 1824 1824 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 1826 1826 & RESULT(tf_att) 1827 1827 !------------------------------------------------------------------- 1828 !> @brief 1828 !> @brief 1829 1829 !> this function create array of global attributes. 1830 1830 !> … … 1841 1841 IMPLICIT NONE 1842 1842 1843 ! Argument 1844 CHARACTER(LEN=*), INTENT(IN ) :: cd_bathy 1845 CHARACTER(LEN=*), INTENT(IN ) :: cd_coord 1846 CHARACTER(LEN=*), INTENT(IN ) :: cd_isfdep 1847 TYPE(TNAMH) , INTENT(IN ) :: td_namh 1848 TYPE(TNAMZ) , INTENT(IN ) :: td_namz 1843 ! Argument 1844 CHARACTER(LEN=*), INTENT(IN ) :: cd_bathy 1845 CHARACTER(LEN=*), INTENT(IN ) :: cd_coord 1846 CHARACTER(LEN=*), INTENT(IN ) :: cd_isfdep 1847 TYPE(TNAMH) , INTENT(IN ) :: td_namh 1848 TYPE(TNAMZ) , INTENT(IN ) :: td_namz 1849 1849 1850 1850 ! function … … 1959 1959 ji=ji+1 ; tf_att(ji)=att_init("wdld",td_namz%d_wdld) 1960 1960 ENDIF 1961 1961 1962 1962 END FUNCTION create_meshmask__gloatt 1963 1963 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note: See TracChangeset
for help on using the changeset viewer.
