Changeset 15279 for utils/tools/DOMAINcfg/src/agrif_user.F90
- Timestamp:
- 2021-09-23T12:00:23+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/DOMAINcfg/src/agrif_user.F90
r15059 r15279 46 46 ! 47 47 INTEGER :: irafx, irafy 48 LOGICAL :: ln_perio, l _deg48 LOGICAL :: ln_perio, ldIperio, ldNFold, l_deg 49 49 ! 50 50 irafx = agrif_irhox() … … 73 73 ln_perio = .FALSE. 74 74 l_deg = .TRUE. 75 76 IF( jperio == 1 .OR. jperio == 2 .OR. jperio == 4 ) ln_perio=.TRUE. 75 76 ldIperio = (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 77 ldNFold = jperio >= 3 .AND. jperio <= 6 78 IF( ldIperio.OR.ldNFold ) ln_perio=.TRUE. 77 79 IF ( Agrif_Parent(jphgr_msh)==2 & 78 80 &.OR.Agrif_Parent(jphgr_msh)==3 & … … 113 115 !South: 114 116 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 115 glamf(:,nn_hls) = glamf(:,1+nn_hls) 116 gphif(:,nn_hls) = gphif(:,1+nn_hls) 117 ENDIF 118 117 gphif(:,nn_hls) = gphif(:,1+nn_hls) 118 glamf(:,nn_hls) = glamf(:,1+nn_hls) 119 ENDIF 120 121 IF ( .NOT.ldNFold ) THEN 122 IF ((.not.lk_north).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 123 glamt(:,jpj-nn_hls) = glamt(:,jpj-nn_hls-1) 124 gphit(:,jpj-nn_hls) = gphit(:,jpj-nn_hls-1) 125 glamu(:,jpj-nn_hls) = glamu(:,jpj-nn_hls-1) 126 gphiu(:,jpj-nn_hls) = gphiu(:,jpj-nn_hls-1) 127 glamv(:,jpj-nn_hls) = glamv(:,jpj-nn_hls-1) 128 gphiv(:,jpj-nn_hls) = gphiv(:,jpj-nn_hls-1) 129 glamf(:,jpj-nn_hls) = glamf(:,jpj-nn_hls-1) 130 gphif(:,jpj-nn_hls) = gphif(:,jpj-nn_hls-1) 131 ENDIF 132 ENDIF 119 133 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 120 glamt(:,jpj) = glamt(:,jpj-1) 121 gphit(:,jpj) = gphit(:,jpj-1) 122 glamu(:,jpj) = glamu(:,jpj-1) 123 gphiu(:,jpj) = gphiu(:,jpj-1) 124 glamv(:,jpj) = glamv(:,jpj-1) 125 gphiv(:,jpj) = gphiv(:,jpj-1) 126 glamf(:,jpj) = glamf(:,jpj-1) 127 gphif(:,jpj) = gphif(:,jpj-1) 134 glamf(:,jpj-nn_hls+1) = glamf(:,jpj-nn_hls) 135 gphif(:,jpj-nn_hls+1) = gphif(:,jpj-nn_hls) 128 136 ENDIF 129 137 130 138 ! Correct West and East 131 IF( jperio /= 1) THEN139 IF( .NOT.ldIperio ) THEN 132 140 IF((nbondi == -1) .OR. (nbondi == 2) ) THEN 133 glamt(1,:) = glamt(2,:) 134 gphit(1,:) = gphit(2,:) 135 glamu(1,:) = glamu(2,:) 136 gphiu(1,:) = gphiu(2,:) 137 glamv(1,:) = glamv(2,:) 138 gphiv(1,:) = gphiv(2,:) 139 glamf(1,:) = glamf(2,:) 140 gphif(1,:) = gphif(2,:) 141 glamt(1+nn_hls,:) = glamt(2+nn_hls,:) 142 gphit(1+nn_hls,:) = gphit(2+nn_hls,:) 143 glamv(1+nn_hls,:) = glamv(2+nn_hls,:) 144 gphiv(1+nn_hls,:) = gphiv(2+nn_hls,:) 141 145 ENDIF 142 146 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 143 glamt(jpi,:) = glamt(jpi-1,:) 144 gphit(jpi,:) = gphit(jpi-1,:) 145 glamu(jpi,:) = glamu(jpi-1,:) 146 gphiu(jpi,:) = gphiu(jpi-1,:) 147 glamv(jpi,:) = glamv(jpi-1,:) 148 gphiv(jpi,:) = gphiv(jpi-1,:) 149 glamf(jpi,:) = glamf(jpi-1,:) 150 gphif(jpi,:) = gphif(jpi-1,:) 151 ENDIF 152 ENDIF 153 !South: 154 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 155 glamf(:,1) = glamf(:,2) 156 ENDIF 147 glamt(jpi-nn_hls,:) = glamt(jpi-nn_hls-1,:) 148 gphit(jpi-nn_hls,:) = gphit(jpi-nn_hls-1,:) 149 glamu(jpi-nn_hls,:) = glamu(jpi-nn_hls-1,:) 150 gphiu(jpi-nn_hls,:) = gphiu(jpi-nn_hls-1,:) 151 glamv(jpi-nn_hls,:) = glamv(jpi-nn_hls-1,:) 152 gphiv(jpi-nn_hls,:) = gphiv(jpi-nn_hls-1,:) 153 glamf(jpi-nn_hls,:) = glamf(jpi-nn_hls-1,:) 154 gphif(jpi-nn_hls,:) = gphif(jpi-nn_hls-1,:) 155 ENDIF 156 ENDIF 157 IF((nbondi == -1) .OR. (nbondi == 2) ) THEN 158 gphif(nn_hls,:) = gphif(nn_hls+1,:) 159 glamf(nn_hls,:) = glamf(nn_hls+1,:) 160 ENDIF 161 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 162 glamf(jpi-nn_hls+1,:) = glamf(jpi-nn_hls,:) 163 gphif(jpi-nn_hls+1,:) = gphif(jpi-nn_hls,:) 164 ENDIF 165 157 166 CALL agrif_init_scales() 158 167 168 ! Fill ghost points in case of closed boundaries: 159 169 ! Correct South and North 160 IF ((. not.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN170 IF ((.NOT.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 161 171 e1t(:,1+nn_hls) = e1t(:,2+nn_hls) 162 172 e2t(:,1+nn_hls) = e2t(:,2+nn_hls) … … 164 174 e2u(:,1+nn_hls) = e2u(:,2+nn_hls) 165 175 ENDIF 166 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 167 e1t(:,jpj) = e1t(:,jpj-1) 168 e2t(:,jpj) = e2t(:,jpj-1) 169 e1u(:,jpj) = e1u(:,jpj-1) 170 e2u(:,jpj) = e2u(:,jpj-1) 171 e1v(:,jpj) = e1v(:,jpj-1) 172 e2v(:,jpj) = e2v(:,jpj-1) 173 e1f(:,jpj) = e1f(:,jpj-1) 174 e2f(:,jpj) = e2f(:,jpj-1) 176 IF ( .NOT.ldNFold ) THEN 177 IF((.NOT.lk_north).AND.((nbondj == 1) .OR. (nbondj == 2) )) THEN 178 e1t(:,jpj-nn_hls) = e1t(:,jpj-nn_hls-1) 179 e2t(:,jpj-nn_hls) = e2t(:,jpj-nn_hls-1) 180 e1u(:,jpj-nn_hls) = e1u(:,jpj-nn_hls-1) 181 e2u(:,jpj-nn_hls) = e2u(:,jpj-nn_hls-1) 182 e1v(:,jpj-nn_hls) = e1v(:,jpj-nn_hls-1) 183 e2v(:,jpj-nn_hls) = e2v(:,jpj-nn_hls-1) 184 e1f(:,jpj-nn_hls) = e1f(:,jpj-nn_hls-1) 185 e2f(:,jpj-nn_hls) = e2f(:,jpj-nn_hls-1) 186 ENDIF 175 187 ENDIF 176 188 177 189 ! Correct West and East 178 IF( jperio /= 1 ) THEN 179 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 180 e1t(1,:) = e1t(2,:) 181 e2t(1,:) = e2t(2,:) 182 e1u(1,:) = e1u(2,:) 183 e2u(1,:) = e2u(2,:) 184 e1v(1,:) = e1v(2,:) 185 e2v(1,:) = e2v(2,:) 186 ENDIF 187 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 188 e1t(jpi,:) = e1t(jpi-1,:) 189 e2t(jpi,:) = e2t(jpi-1,:) 190 e1u(jpi,:) = e1u(jpi-1,:) 191 e2u(jpi,:) = e2u(jpi-1,:) 192 e1v(jpi,:) = e1v(jpi-1,:) 193 e2v(jpi,:) = e2v(jpi-1,:) 194 e1f(jpi,:) = e1f(jpi-1,:) 195 e2f(jpi,:) = e2f(jpi-1,:) 190 IF( .NOT.ldIperio ) THEN 191 IF((.NOT.lk_west).AND.(nbondj == -1).OR.(nbondj == 2) ) THEN 192 e1t(1+nn_hls,:) = e1t(2+nn_hls,:) 193 e2t(1+nn_hls,:) = e2t(2+nn_hls,:) 194 e1v(1+nn_hls,:) = e1v(2+nn_hls,:) 195 e2v(1+nn_hls,:) = e2v(2+nn_hls,:) 196 ENDIF 197 IF((.NOT.lk_east).AND.(nbondj == 1) .OR. (nbondj == 2) ) THEN 198 e1t(jpi-nn_hls,:) = e1t(jpi-nn_hls-1,:) 199 e2t(jpi-nn_hls,:) = e2t(jpi-nn_hls-1,:) 200 e1u(jpi-nn_hls,:) = e1u(jpi-nn_hls-1,:) 201 e2u(jpi-nn_hls,:) = e2u(jpi-nn_hls-1,:) 202 e1v(jpi-nn_hls,:) = e1v(jpi-nn_hls-1,:) 203 e2v(jpi-nn_hls,:) = e2v(jpi-nn_hls-1,:) 204 e1f(jpi-nn_hls,:) = e1f(jpi-nn_hls-1,:) 205 e2f(jpi-nn_hls,:) = e2f(jpi-nn_hls-1,:) 196 206 ENDIF 197 207 ENDIF … … 222 232 !--------------------------------------------------------------------- 223 233 224 ind2 = nn_hls + 1 + nbghostcells_x 234 ind2 = nn_hls + 1 + nbghostcells_x_w 225 235 ind3 = nn_hls + 1 + nbghostcells_y_s 226 236 227 nbghostcellsfine_tot_x= nbghostcells_x+1237 nbghostcellsfine_tot_x=max(nbghostcells_x_w,nbghostcells_x_e)+1 228 238 nbghostcellsfine_tot_y=max(nbghostcells_y_s,nbghostcells_y_n)+1 229 239 … … 232 242 ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 233 243 ! The procnames will not be CALLed at these boundaries 234 if ( jperio == 1) THEN244 if (.not.lk_west) THEN 235 245 CALL Agrif_Set_NearCommonBorderX(.TRUE.) 246 endif 247 if (.not.lk_east) THEN 236 248 CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 237 249 endif … … 360 372 CALL Agrif_Set_interp(e3t_copy_id,interp=AGRIF_constant) 361 373 CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/)) 374 CALL Agrif_Set_Updatetype( e3t_copy_id, update = AGRIF_Update_Max) 362 375 363 376 ! CALL Agrif_Set_bcinterp(e3t_connect_id,interp=AGRIF_linear) … … 417 430 bounds_chunks(i,:,:,:) = bounds 418 431 END DO 419 420 432 ! FIRST CHUNCK (for j<=jpjglo) 421 422 433 ! Original indices 423 434 bounds_chunks(1,1,1,1) = bounds(1,1,2) … … 439 450 bounds_chunks(2,1,1,1) = bounds(1,1,2) 440 451 bounds_chunks(2,1,2,1) = bounds(1,2,2) 441 bounds_chunks(2,2,1,1) = jpjglo-2 452 bounds_chunks(2,2,1,1) = jpjglo-2*nn_hls 442 453 bounds_chunks(2,2,2,1) = bounds(2,2,2) 443 454 444 455 ! Where to find them 445 456 ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 457 ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2*nn_hls-(jj-jpjglo)) 446 458 447 459 IF (ptx == 2) THEN ! T, V points … … 454 466 455 467 IF (pty == 2) THEN ! T, U points 456 bounds_chunks(2,2,1,2) = jpjglo-2 -(bounds(2,2,2) -jpjglo)457 bounds_chunks(2,2,2,2) = jpjglo-2 -(jpjglo-2-jpjglo)468 bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 469 bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-(jpjglo-nn_hls -jpjglo) 458 470 ELSE ! V, F points 459 bounds_chunks(2,2,1,2) = jpjglo- 3-(bounds(2,2,2) -jpjglo)460 bounds_chunks(2,2,2,2) = jpjglo- 3-(jpjglo-2-jpjglo)471 bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 472 bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-1-(jpjglo-nn_hls -jpjglo) 461 473 ENDIF 462 474 … … 465 477 466 478 ELSE 467 468 479 nb_chunks = 1 469 480 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) … … 481 492 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 482 493 483 bounds_chunks(1,2,1,2) = jpjglo- 2-(bounds(2,2,2)-jpjglo)484 bounds_chunks(1,2,2,2) = jpjglo- 2-(bounds(2,1,2)-jpjglo)494 bounds_chunks(1,2,1,2) = jpjglo-nn_hls-1-(bounds(2,2,2)-jpjglo) 495 bounds_chunks(1,2,2,2) = jpjglo-nn_hls-1-(bounds(2,1,2)-jpjglo) 485 496 486 497 IF (ptx == 2) THEN ! T, V points … … 493 504 494 505 IF (pty == 2) THEN ! T, U points 495 bounds_chunks(1,2,1,2) = jpjglo-2 -(bounds(2,2,2) -jpjglo)496 bounds_chunks(1,2,2,2) = jpjglo-2 -(bounds(2,1,2) -jpjglo)506 bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 507 bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-(bounds(2,1,2) -jpjglo) 497 508 ELSE ! V, F points 498 bounds_chunks(1,2,1,2) = jpjglo- 3-(bounds(2,2,2) -jpjglo)499 bounds_chunks(1,2,2,2) = jpjglo- 3-(bounds(2,1,2) -jpjglo)509 bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 510 bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-1-(bounds(2,1,2) -jpjglo) 500 511 ENDIF 501 512 … … 505 516 506 517 ELSE IF ( (bounds(1,1,2) < 1).AND.ldIperio ) THEN 507 518 508 519 IF (bounds(1,2,2) > 0) THEN 509 520 nb_chunks = 2 … … 515 526 END DO 516 527 517 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 518 bounds_chunks(1,1,2,2) = 1+jpiglo-2528 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 529 bounds_chunks(1,1,2,2) = jpiglo-nn_hls 519 530 520 531 bounds_chunks(1,1,1,1) = bounds(1,1,2) 521 bounds_chunks(1,1,2,1) = 1 522 523 bounds_chunks(2,1,1,2) = 2532 bounds_chunks(1,1,2,1) = 1+nn_hls 533 534 bounds_chunks(2,1,1,2) = 1+nn_hls 524 535 bounds_chunks(2,1,2,2) = bounds(1,2,2) 525 536 526 bounds_chunks(2,1,1,1) = 2537 bounds_chunks(2,1,1,1) = 1+nn_hls 527 538 bounds_chunks(2,1,2,1) = bounds(1,2,2) 528 539 ELSE … … 534 545 bounds_chunks(i,:,:,:) = bounds 535 546 END DO 536 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 537 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 547 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 548 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2*nn_hls 538 549 539 550 bounds_chunks(1,1,1,1) = bounds(1,1,2) … … 577 588 ELSE IF (isens ==2) THEN 578 589 IF (pty == 2) THEN ! T, U points 579 agrif_external_switch_index = jpjglo-2 -(i1 -jpjglo)590 agrif_external_switch_index = jpjglo-2*nn_hls-(i1 -jpjglo) 580 591 ELSE ! V, F points 581 agrif_external_switch_index = jpjglo- 3-(i1 -jpjglo)592 agrif_external_switch_index = jpjglo-2*nn_hls-1-(i1 -jpjglo) 582 593 ENDIF 583 594 ENDIF … … 1094 1105 1095 1106 INTEGER :: ios 1096 1097 NAMELIST/namagrif/ nn_cln_update,ln_spc_dyn,rn_sponge_tra,rn_sponge_dyn,ln_chk_bathy,npt_connect, & 1098 & npt_copy1107 INTEGER :: imin, imax, jmin, jmax 1108 1109 NAMELIST/namagrif/ ln_vert_remap, npt_connect, npt_copy 1099 1110 1100 1111 ! REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : nesting parameters … … 1107 1118 IF(lwm) WRITE ( numond, namagrif ) 1108 1119 1120 IF (.NOT.Agrif_Root()) THEN 1121 1122 IF(lwp) THEN ! Control print 1123 WRITE(numout,*) 1124 WRITE(numout,*) 'agrif_nemo_init : nesting' 1125 WRITE(numout,*) '~~~~~~~' 1126 WRITE(numout,*) ' Namelist namagrif : set nesting parameters' 1127 WRITE(numout,*) ' ln_vert_remap = ', ln_vert_remap 1128 WRITE(numout,*) ' npt_copy = ', npt_copy 1129 WRITE(numout,*) ' npt_connect = ', npt_connect 1130 ENDIF 1131 1132 imin = Agrif_Ix() 1133 imax = Agrif_Ix() + nbcellsx/AGRIF_Irhox() 1134 jmin = Agrif_Iy() 1135 jmax = Agrif_Iy() + nbcellsy/AGRIF_Irhoy() 1136 lk_west = .TRUE. ; lk_east = .TRUE. 1137 lk_north = .TRUE. ; lk_south = .TRUE. 1138 1139 ! Check zoom position along i: 1140 ! ---------------------------- 1141 IF ( imin >= imax ) THEN 1142 CALL ctl_stop( 'STOP', 'AGRIF zoom imin must be < imax' ) 1143 ENDIF 1144 1145 IF ( (Agrif_Parent(jperio)==4).OR.(Agrif_Parent(jperio)==1) ) THEN 1146 IF ( (jperio==4).OR.(jperio==1) ) THEN ! Cyclic east-west zoom 1147 lk_west = .FALSE. ; lk_east = .FALSE. 1148 ! Checks: 1149 IF ( imin/=1-Agrif_Parent(nbghostcells_x_w) ) THEN 1150 WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imin must = ', & 1151 1 - Agrif_Parent(nbghostcells_x_w) 1152 CALL ctl_stop( 'STOP', ctmp1 ) 1153 ENDIF 1154 IF ( imax/=Agrif_Parent(Ni0glo)+1-Agrif_Parent(nbghostcells_x_w)) THEN 1155 WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imax must = ', & 1156 Agrif_Parent(Ni0glo) + 1 - Agrif_Parent(nbghostcells_x_w) 1157 CALL ctl_stop( 'STOP', ctmp1 ) 1158 ENDIF 1159 ELSE 1160 IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 1161 WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 1162 Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 1163 CALL ctl_stop( 'STOP', ctmp1 ) 1164 ENDIF 1165 ENDIF 1166 ELSE 1167 IF ( imin<2-Agrif_Parent(nbghostcells_x_w) ) THEN 1168 WRITE(ctmp1, 9000) ' AGRIF zoom imin must be >= ', & 1169 2 - Agrif_Parent(nbghostcells_x_w) 1170 CALL ctl_stop( 'STOP', ctmp1 ) 1171 ENDIF 1172 IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 1173 WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 1174 Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 1175 CALL ctl_stop( 'STOP', ctmp1 ) 1176 ENDIF 1177 IF ( imin==2-Agrif_Parent(nbghostcells_x_w) ) lk_west = .FALSE. ! Set along wall 1178 IF ( imax==Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w) ) lk_east = .FALSE. ! Set along wall 1179 ENDIF 1180 1181 ! Check zoom position along j: 1182 ! ---------------------------- 1183 IF ( jmin >= jmax ) THEN 1184 CALL ctl_stop( 'STOP', 'AGRIF zoom jmin must be < jmax' ) 1185 ENDIF 1186 1187 IF ( Agrif_Parent(jperio)==4 ) THEN 1188 IF (jperio==4) THEN ! North-Fold 1189 lk_north = .FALSE. 1190 ! Checks: 1191 IF ( jmax/=Agrif_Parent(Nj0glo)+1-Agrif_Parent(nbghostcells_y_s)) THEN 1192 WRITE(ctmp1, 9000) ' AGRIF zoom has a North-Fold, jmax must = ', & 1193 Agrif_Parent(Nj0glo) + 1 - Agrif_Parent(nbghostcells_y_s) 1194 CALL ctl_stop( 'STOP', ctmp1 ) 1195 ENDIF 1196 ENDIF 1197 ELSE 1198 IF ( jmax>Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s)) THEN 1199 WRITE(ctmp1, 9000) ' AGRIF zoom jmax must be <= ', & 1200 Agrif_Parent(Nj0glo) - Agrif_Parent(nbghostcells_y_s) 1201 CALL ctl_stop( 'STOP', ctmp1 ) 1202 ENDIF 1203 IF ( jmax==Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s) ) lk_north = .FALSE. ! Set along wall 1204 ENDIF 1205 1206 IF ( jmin<2-Agrif_Parent(nbghostcells_y_s)) THEN 1207 WRITE(ctmp1, 9000) ' AGRIF zoom jmin must be >= ', & 1208 2 - Agrif_Parent(nbghostcells_y_s) 1209 CALL ctl_stop( 'STOP', ctmp1 ) 1210 ENDIF 1211 IF ( jmin==2-Agrif_Parent(nbghostcells_y_s) ) lk_south = .FALSE. ! Set along wall 1212 1213 ELSE ! Root grid 1214 lk_west = .FALSE. ; lk_east = .FALSE. 1215 lk_north = .FALSE. ; lk_south = .FALSE. 1216 ENDIF 1217 1218 ! Set ghost cells: 1219 nbghostcells_x_w = nbghostcells 1220 nbghostcells_x_e = nbghostcells 1221 nbghostcells_y_s = nbghostcells 1222 nbghostcells_y_n = nbghostcells 1223 1224 IF (.NOT.lk_west ) nbghostcells_x_w = 1 1225 IF (.NOT.lk_east ) nbghostcells_x_e = 1 1226 IF (.NOT.lk_south) nbghostcells_y_s = 1 1227 IF (.NOT.lk_north) nbghostcells_y_n = 1 1228 1229 IF ((jperio == 1).OR.(jperio == 4)) THEN 1230 nbghostcells_x_w = 0 ; nbghostcells_x_e = 0 1231 ENDIF 1232 IF (jperio == 4) THEN 1233 nbghostcells_y_n = 0 1234 ENDIF 1235 1109 1236 IF(lwp) THEN ! Control print 1110 1237 WRITE(numout,*) 1111 WRITE(numout,*) 'agrif_nemo_init : nesting' 1112 WRITE(numout,*) '~~~~~~~' 1113 WRITE(numout,*) ' Namelist namagrif : set nesting parameters' 1114 WRITE(numout,*) ' npt_copy = ', npt_copy 1115 WRITE(numout,*) ' npt_connect = ', npt_connect 1116 ENDIF 1117 1118 ! Set the number of ghost cells according to periodicity 1119 1120 IF (.not.agrif_root()) THEN 1121 lk_west = .NOT. ( Agrif_Ix() == 1 ) 1122 lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) + 1 ) 1123 lk_south = .NOT. ( Agrif_Iy() == 1 ) 1124 lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) - 1 ) 1125 1126 nbghostcells_x = nbghostcells 1127 nbghostcells_y_s = nbghostcells 1128 nbghostcells_y_n = nbghostcells 1129 1130 IF (.NOT.lk_south) THEN 1131 nbghostcells_y_s = 1 1132 ENDIF 1133 IF (.NOT.lk_north) THEN 1134 nbghostcells_y_n = 1 1135 ENDIF 1136 1137 IF ((jperio == 1).OR.(jperio == 4)) THEN 1138 nbghostcells_x = 0 1139 ENDIF 1140 IF(lwp) THEN ! Control print 1141 WRITE(numout,*) 1142 WRITE(numout,*) 'nbghostcells_y_s', nbghostcells_y_s 1143 WRITE(numout,*) 'nbghostcells_y_n', nbghostcells_y_n 1144 WRITE(numout,*) 'nbghostcells_x', nbghostcells_x 1145 WRITE(numout,*) 'lk_west', lk_west 1146 WRITE(numout,*) 'lk_east', lk_east 1147 WRITE(numout,*) 'lk_south', lk_south 1148 WRITE(numout,*) 'lk_north', lk_north 1149 ENDIF 1150 ELSE ! root grid 1151 nbghostcells_x = 1 1152 nbghostcells_y_s = 1 1153 nbghostcells_y_n = 1 1154 1155 IF ((jperio == 1).OR.(jperio == 4)) THEN 1156 nbghostcells_x = 0 1157 ENDIF 1158 IF (jperio == 4) THEN 1159 nbghostcells_y_n = 0 ! for completeness 1160 ENDIF 1161 ENDIF 1238 WRITE(numout,*) 'AGRIF boundaries and ghost cells:' 1239 WRITE(numout,*) 'lk_west' , lk_west 1240 WRITE(numout,*) 'lk_east' , lk_east 1241 WRITE(numout,*) 'lk_south', lk_south 1242 WRITE(numout,*) 'lk_north', lk_north 1243 WRITE(numout,*) 'nbghostcells_y_s', nbghostcells_y_s 1244 WRITE(numout,*) 'nbghostcells_y_n', nbghostcells_y_n 1245 WRITE(numout,*) 'nbghostcells_x_w', nbghostcells_x_w 1246 WRITE(numout,*) 'nbghostcells_x_e', nbghostcells_x_e 1247 ENDIF 1248 1249 9000 FORMAT (a, i4) 1162 1250 1163 1251 END SUBROUTINE agrif_nemo_init
Note: See TracChangeset
for help on using the changeset viewer.