Changeset 7421 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC
- Timestamp:
- 2016-12-01T18:10:41+01:00 (8 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 3 edited
-
lib_mpp.F90 (modified) (6 diffs)
-
mppini.F90 (modified) (7 diffs)
-
mppini_2.h90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6918 r7421 405 405 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 406 406 ENDIF 407 ! ! North-South boundaries (always closed) 408 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 409 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 407 ! North-south cyclic 408 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south only with no mpp split in latitude 409 ptab(:,1 , :) = ptab(:, jpjm1,:) 410 ptab(:,jpj,:) = ptab(:, 2,:) 411 ELSE ! ! North-South boundaries (closed) 412 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 413 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 414 ENDIF 410 415 ! 411 416 ENDIF … … 608 613 pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi ,:) = zland ! north 609 614 ENDIF 610 ! ! North-South boundaries (always closed) 615 ! Noth-South boundaries 616 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 617 pt2d_array(ii)%pt2d(:, 1 ) = pt2d_array(ii)%pt2d(:, jpjm1 ) 618 pt2d_array(ii)%pt2d(:, jpj ) = pt2d_array(ii)%pt2d(:, 2 ) 619 ELSE ! 620 ! ! North-South boundaries (closed) 611 621 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d(:, 1:jprecj ) = zland ! south except F-point 612 622 pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj ) = zland ! north 613 623 ! 614 ENDIF 624 ENDIF 625 ENDIF 615 626 END DO 616 627 … … 888 899 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 889 900 ENDIF 890 ! ! North-South boundaries (always closed) 901 ! North-South boudaries 902 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 903 pt2d(:, 1 ) = pt2d(:,jpjm1) 904 pt2d(:, jpj) = pt2d(:, 2) 905 ELSE 906 ! ! North-South boundaries (closed) 891 907 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 892 908 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 893 !909 ENDIF 894 910 ENDIF 895 911 … … 1071 1087 ptab2(nlci-jpreci+1:jpi ,:,:) = 0.e0 1072 1088 ENDIF 1073 1074 1075 ! ! North-South boundaries 1089 ! North-South boundaries 1090 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1091 ptab1(:, 1 ,:) = ptab1(: , jpjm1 , :) 1092 ptab1(:, jpj ,:) = ptab1(: , 2 , :) 1093 ptab2(:, 1 ,:) = ptab2(: , jpjm1 , :) 1094 ptab2(:, jpj ,:) = ptab2(: , 2 , :) 1095 ELSE 1096 ! ! North-South boundaries closed 1076 1097 IF( .NOT. cd_type1 == 'F' ) ptab1(:, 1 :jprecj,:) = 0.e0 ! south except at F-point 1077 1098 IF( .NOT. cd_type2 == 'F' ) ptab2(:, 1 :jprecj,:) = 0.e0 1078 1099 ptab1(:,nlcj-jprecj+1:jpj ,:) = 0.e0 ! north 1079 1100 ptab2(:,nlcj-jprecj+1:jpj ,:) = 0.e0 1080 1101 ENDIF 1081 1102 1082 1103 ! 2. East and west directions exchange … … 1267 1288 ! Order matters Here !!!! 1268 1289 ! 1269 ! !* North-South boundaries (always colsed) 1290 ! North-South cyclic 1291 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1292 pt2d(:, 1-jprj: 1 ) = pt2d ( :, jpjm1-jprj:jpjm1) 1293 pt2d(:, jpj :jpj+jprj) = pt2d ( :, 2 :2+jprj) 1294 ELSE 1295 1296 ! !* North-South boundaries (closed) 1270 1297 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0.e0 ! south except at F-point 1271 1298 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0 ! north 1272 1299 ENDIF 1300 1273 1301 ! ! East-West boundaries 1274 1302 ! !* Cyclic east-west … … 4304 4332 WRITE(kout,*) 4305 4333 ENDIF 4334 CALL FLUSH(kout) 4306 4335 STOP 'ctl_opn bad opening' 4307 4336 ENDIF -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r6412 r7421 65 65 WRITE(numout,*) 66 66 WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing' 67 WRITE(numout,*) '~~~~~~~~~~~ :'67 WRITE(numout,*) '~~~~~~~~~~~ ' 68 68 WRITE(numout,*) ' nperio = ', nperio 69 69 WRITE(numout,*) ' npolj = ', npolj … … 76 76 & 'the domain is lay out for distributed memory computing! ' ) 77 77 78 IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ', & 79 & ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 78 80 END SUBROUTINE mpp_init 79 81 … … 265 267 266 268 IF(lwp) WRITE(numout,*) 267 IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 268 IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------' 269 IF(lwp) WRITE(numout,*) 270 IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 271 IF(lwp) WRITE(numout,*) 272 IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 269 IF(lwp) WRITE(numout,*) ' defines mpp subdomains' 270 IF(lwp) WRITE(numout,*) ' jpni=', jpni, ' iresti=', iresti 271 IF(lwp) WRITE(numout,*) ' jpnj=', jpnj, ' irestj=', irestj 273 272 zidom = nreci 274 273 DO ji = 1, jpni … … 276 275 END DO 277 276 IF(lwp) WRITE(numout,*) 278 IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo277 IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 279 278 280 279 zjdom = nrecj … … 282 281 zjdom = zjdom + ilcjt(1,jj) - nrecj 283 282 END DO 284 IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 285 IF(lwp) WRITE(numout,*) 283 IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 286 284 287 285 IF(lwp) THEN … … 360 358 njmpp = njmppt(narea) 361 359 362 ! Save processor layout in layout.dat file363 IF(lwp) THEN364 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )365 WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo'366 WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo367 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'368 369 DOjn = 1, jpnij370 WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &371 372 373 374 END DO375 CLOSE(inum)360 ! Save processor layout in layout.dat file 361 IF(lwp) THEN 362 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 363 WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo' 364 WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 365 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 366 ! 367 DO jn = 1, jpnij 368 WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), & 369 & nldit(jn), nldjt(jn), & 370 & nleit(jn), nlejt(jn), & 371 & nimppt(jn), njmppt(jn) 372 END DO 373 CLOSE(inum) 376 374 END IF 377 375 378 379 376 ! w a r n i n g narea (zone) /= nproc (processors)! 380 377 381 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN378 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 382 379 IF( jpni == 1 )THEN 383 380 nbondi = 2 … … 428 425 429 426 IF(lwp) THEN 430 WRITE(numout,*) ' nproc = ', nproc 431 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 432 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 433 WRITE(numout,*) ' nbondi = ', nbondi 434 WRITE(numout,*) ' nbondj = ', nbondj 435 WRITE(numout,*) ' npolj = ', npolj 436 WRITE(numout,*) ' nperio = ', nperio 437 WRITE(numout,*) ' nlci = ', nlci 438 WRITE(numout,*) ' nlcj = ', nlcj 439 WRITE(numout,*) ' nimpp = ', nimpp 440 WRITE(numout,*) ' njmpp = ', njmpp 441 WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse 442 WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw 443 WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne 444 WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw 427 WRITE(numout,*) ' nproc = ', nproc 428 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 429 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 430 WRITE(numout,*) ' nbondi = ', nbondi, ' nbondj = ', nbondj 431 WRITE(numout,*) ' npolj = ', npolj 432 WRITE(numout,*) ' nperio = ', nperio 433 WRITE(numout,*) ' nlci = ', nlci , ' nlcj = ', nlcj 434 WRITE(numout,*) ' nimpp = ', nimpp , ' njmpp = ', njmpp 435 WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse 436 WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw 437 WRITE(numout,*) ' jpreci = ', jpreci, ' npne = ', npne 438 WRITE(numout,*) ' jprecj = ', jprecj, ' npnw = ', npnw 445 439 WRITE(numout,*) 446 440 ENDIF 447 441 442 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 443 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 448 444 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 449 445 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r7412 r7421 6 6 !! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED 7 7 !! FOR DEFINING BETTER CUTTING OUT. 8 !! This routine is used with a the bathymetryfile.8 !! This routine requires the presence of the domain configuration file. 9 9 !! In this version, the land processors are avoided and the adress 10 10 !! processor (nproc, narea,noea, ...) are calculated again. … … 32 32 !! nono : number for local neighboring processor 33 33 !! 34 !! History : 35 !! ! 94-11 (M. Guyon) Original code36 !! ! 95-04 (J. Escobar, M. Imbard)37 !! ! 98-02 (M. Guyon) FETI method38 !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions39 !! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 134 !! History : ! 1994-11 (M. Guyon) Original code 35 !! OPA ! 1995-04 (J. Escobar, M. Imbard) 36 !! ! 1998-02 (M. Guyon) FETI method 37 !! ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 38 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 39 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 40 40 !!---------------------------------------------------------------------- 41 41 USE in_out_manager ! I/O Manager … … 66 66 ione , ionw , iose , iosw , & ! " " 67 67 ibne , ibnw , ibse , ibsw ! " " 68 INTEGER, DIMENSION(jpiglo,jpjglo) :: & 69 imask ! temporary global workspace 70 REAL(wp), DIMENSION(jpiglo,jpjglo) :: & 71 zdta, zdtaisf ! temporary data workspace 72 REAL(wp) :: zidom , zjdom ! temporary scalars 73 74 ! read namelist for ln_zco 75 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 68 INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! global workspace 69 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zbot, ztop ! global workspace 70 REAL(wp) :: zidom , zjdom ! local scalars 76 71 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & 77 72 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & … … 82 77 & ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 83 78 !!---------------------------------------------------------------------- 84 !! OPA 9.0 , LOCEAN-IPSL (2005)79 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 85 80 !! $Id$ 86 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt81 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 87 82 !!---------------------------------------------------------------------- 88 83 89 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate90 READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)91 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )92 93 REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate94 READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )95 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )96 IF(lwm) WRITE ( numond, namzgr )97 98 84 IF(lwp)WRITE(numout,*) 99 IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'100 IF(lwp)WRITE(numout,*) '~~~~~~~~ '85 IF(lwp)WRITE(numout,*) 'mpp_init_2 : Message Passing MPI' 86 IF(lwp)WRITE(numout,*) '~~~~~~~~~~' 101 87 IF(lwp)WRITE(numout,*) ' ' 102 88 103 IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )89 IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 104 90 105 91 ! 0. initialisation 106 92 ! ----------------- 107 108 ! open the file 109 ! Remember that at this level in the code, mpp is not yet initialized, so 110 ! the file must be open with jpdom_unknown, and kstart and kcount forced 111 jstartrow = 1 112 IF ( ln_zco ) THEN 113 CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry 114 ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 115 ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 116 CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 117 jstartrow = MAX(1,jstartrow) 118 CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 119 ELSE 120 CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps 121 IF ( ln_isfcav ) THEN 122 CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 123 ELSE 124 ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 125 ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 126 CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 127 jstartrow = MAX(1,jstartrow) 128 CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/) & 129 & , kcount=(/jpiglo,jpjglo/) ) 130 ENDIF 131 ENDIF 132 CALL iom_close (inum) 133 134 ! used to compute the land processor in case of not masked bathy file. 135 zdtaisf(:,:) = 0.0_wp 136 IF ( ln_isfcav ) THEN 137 CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps 138 CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 139 END IF 140 CALL iom_close (inum) 141 142 ! land/sea mask over the global/zoom domain 143 144 imask(:,:)=1 145 WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 93 CALL iom_open( cn_domcfg, inum ) 94 ! 95 ! ! ocean top and bottom level 96 CALL iom_get( inum, jpdom_data, 'bottom_level' , zbot ) ! nb of ocean T-points 97 CALL iom_get( inum, jpdom_data, 'top_level' , ztop ) ! nb of ocean T-points (ISF) 98 ! 99 CALL iom_close( inum ) 100 ! 101 ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 102 WHERE( zbot(:,:) - ztop(:,:) + 1 > 0 ) ; imask(:,:) = 1 103 ELSEWHERE ; imask(:,:) = 0 104 END WHERE 146 105 147 106 ! Adjust imask with bdy_msk if exists … … 347 306 DO jj = 1, ilj 348 307 DO ji = 1, ili 349 IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1308 IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 350 309 END DO 351 310 END DO
Note: See TracChangeset
for help on using the changeset viewer.
