- Timestamp:
- 2013-06-13T12:50:37+02:00 (11 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 4 edited
-
NST_SRC/agrif_lim2_interp.F90 (modified) (7 diffs)
-
NST_SRC/agrif_opa_sponge.F90 (modified) (6 diffs)
-
NST_SRC/agrif_opa_update.F90 (modified) (5 diffs)
-
OPA_SRC/LBC/lib_mpp.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r3916 r3918 334 334 !! we are in inside a new parent ice time step 335 335 !!----------------------------------------------------------------------- 336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 3d336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 337 337 INTEGER :: ji,jj,jn 338 338 !!----------------------------------------------------------------------- … … 345 345 adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) 346 346 ! interpolation of boundaries 347 ztab 3d(:,:,:) = 0.347 ztab(:,:,:) = 0. 348 348 Agrif_SpecialValue=-9999. 349 349 Agrif_UseSpecialValue = .TRUE. 350 CALL Agrif_Bc_variable( ztab 3d, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )350 CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 351 351 Agrif_SpecialValue=0. 352 352 Agrif_UseSpecialValue = .FALSE. … … 356 356 DO jj = 1, jpj 357 357 DO ji=1,2 358 adv_ice_oe(ji ,jj,jn,2) = ztab 3d(ji ,jj,jn)359 adv_ice_oe(ji+2,jj,jn,2) = ztab 3d(nlci-2+ji,jj,jn)358 adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn) 359 adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) 360 360 END DO 361 361 END DO … … 365 365 Do jj =1,2 366 366 DO ji = 1, jpi 367 adv_ice_sn(ji,jj ,jn,2) = ztab 3d(ji,jj ,jn)368 adv_ice_sn(ji,jj+2,jn,2) = ztab 3d(ji,nlcj-2+jj,jn)367 adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn) 368 adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) 369 369 END DO 370 370 END DO … … 384 384 INTEGER :: ji,jj,jn 385 385 REAL(wp) :: zalpha 386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 3d386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 387 387 !!----------------------------------------------------------------------- 388 388 ! … … 391 391 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 392 392 ! 393 ztab 3d(:,:,:) = 0.e0393 ztab(:,:,:) = 0.e0 394 394 DO jn =1,7 395 395 DO jj =1,2 396 396 DO ji = 1, jpi 397 ztab 3d(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2)398 ztab 3d(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)397 ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) 398 ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 399 399 END DO 400 400 END DO … … 404 404 DO jj = 1, jpj 405 405 DO ji=1,2 406 ztab 3d(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2)407 ztab 3d(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)408 END DO 409 END DO 410 END DO 411 ! 412 CALL parcoursT( ztab 3d(:,:, 1), frld )413 CALL parcoursT( ztab 3d(:,:, 2), hicif )414 CALL parcoursT( ztab 3d(:,:, 3), hsnif )415 CALL parcoursT( ztab 3d(:,:, 4), tbif(:,:,1) )416 CALL parcoursT( ztab 3d(:,:, 5), tbif(:,:,2) )417 CALL parcoursT( ztab 3d(:,:, 6), tbif(:,:,3) )418 CALL parcoursT( ztab 3d(:,:, 7), qstoif )406 ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 407 ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 408 END DO 409 END DO 410 END DO 411 ! 412 CALL parcoursT( ztab(:,:, 1), frld ) 413 CALL parcoursT( ztab(:,:, 2), hicif ) 414 CALL parcoursT( ztab(:,:, 3), hsnif ) 415 CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) 416 CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) 417 CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) 418 CALL parcoursT( ztab(:,:, 7), qstoif ) 419 419 ! 420 420 END SUBROUTINE agrif_trp_lim2 -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r3916 r3918 34 34 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 35 35 REAL(wp), POINTER, DIMENSION(:,: ) :: ztu, ztv 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 4d36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 37 37 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 38 38 39 39 #if defined SPONGE 40 40 CALL wrk_alloc( jpi, jpj, ztu, ztv ) 41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab 4d, tsbdiff )41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 42 42 43 43 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 45 45 Agrif_SpecialValue=0. 46 46 Agrif_UseSpecialValue = .TRUE. 47 ztab 4d= 0.e048 CALL Agrif_Bc_Variable(ztab 4d, tsa_id,calledweight=timecoeff,procname=interptsn)47 ztab = 0.e0 48 CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 49 49 Agrif_UseSpecialValue = .FALSE. 50 50 51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab 4d(:,:,:,:)51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 52 52 53 53 CALL Agrif_Sponge … … 80 80 81 81 CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab 4d, tsbdiff )82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 83 83 #endif 84 84 … … 95 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 96 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 3d97 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 98 98 99 99 #if defined SPONGE 100 CALL wrk_alloc( jpi, jpj, jpk, ztab 3d, ubdiff, vbdiff, rotdiff, hdivdiff )100 CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 101 101 102 102 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 104 104 Agrif_SpecialValue=0. 105 105 Agrif_UseSpecialValue = ln_spc_dyn 106 ztab 3d= 0.e0107 CALL Agrif_Bc_Variable(ztab 3d, ua_id,calledweight=timecoeff,procname=interpun)106 ztab = 0.e0 107 CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 108 108 Agrif_UseSpecialValue = .FALSE. 109 109 110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab 3d(:,:,:) ) * umask(:,:,:)111 112 ztab 3d= 0.e0110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 111 112 ztab = 0.e0 113 113 Agrif_SpecialValue=0. 114 114 Agrif_UseSpecialValue = ln_spc_dyn 115 CALL Agrif_Bc_Variable(ztab 3d, va_id,calledweight=timecoeff,procname=interpvn)115 CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn) 116 116 Agrif_UseSpecialValue = .FALSE. 117 117 118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab 3d(:,:,:) ) * vmask(:,:,:)118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 119 119 120 120 CALL Agrif_Sponge … … 174 174 END DO ! End of slab 175 175 ! ! =============== 176 CALL wrk_dealloc( jpi, jpj, jpk, ztab 3d, ubdiff, vbdiff, rotdiff, hdivdiff )176 CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 177 177 #endif 178 178 -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r3916 r3918 32 32 !! 33 33 INTEGER, INTENT(in) :: kt 34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 4d34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 35 35 36 36 37 37 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 38 #if defined TWO_WAY 39 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab 4d)39 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 40 40 41 41 Agrif_UseSpecialValueInUpdate = .TRUE. … … 43 43 44 44 IF (MOD(nbcline,nbclineupdate) == 0) THEN 45 CALL Agrif_Update_Variable(ztab 4d,tsn_id, procname=updateTS)46 ELSE 47 CALL Agrif_Update_Variable(ztab 4d,tsn_id,locupdate=(/0,2/), procname=updateTS)45 CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 46 ELSE 47 CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 48 48 ENDIF 49 49 50 50 Agrif_UseSpecialValueInUpdate = .FALSE. 51 51 52 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab 4d)52 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 53 53 #endif 54 54 … … 62 62 INTEGER, INTENT(in) :: kt 63 63 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 3d64 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 65 65 66 66 … … 68 68 #if defined TWO_WAY 69 69 CALL wrk_alloc( jpi, jpj, ztab2d ) 70 CALL wrk_alloc( jpi, jpj, jpk, ztab 3d)70 CALL wrk_alloc( jpi, jpj, jpk, ztab ) 71 71 72 72 IF (mod(nbcline,nbclineupdate) == 0) THEN 73 CALL Agrif_Update_Variable(ztab 3d,un_id,procname = updateU)74 CALL Agrif_Update_Variable(ztab 3d,vn_id,procname = updateV)75 ELSE 76 CALL Agrif_Update_Variable(ztab 3d,un_id,locupdate=(/0,1/),procname = updateU)77 CALL Agrif_Update_Variable(ztab 3d,vn_id,locupdate=(/0,1/),procname = updateV)73 CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 74 CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 75 ELSE 76 CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 77 CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV) 78 78 ENDIF 79 79 … … 89 89 90 90 CALL wrk_dealloc( jpi, jpj, ztab2d ) 91 CALL wrk_dealloc( jpi, jpj, jpk, ztab 3d)91 CALL wrk_dealloc( jpi, jpj, jpk, ztab ) 92 92 93 93 !Done in step -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3799 r3918 162 162 163 163 ! Arrays used in mpp_lbc_north_3d() 164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc 165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather 167 167 168 168 ! Arrays used in mpp_lbc_north_2d() 169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d 171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather 172 172 173 173 ! Arrays used in mpp_lbc_north_e() 174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e, znorthloc_e175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e 176 176 177 177 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public … … 207 207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 208 208 ! 209 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , &210 & zfoldwk(jpi,4,jpk) , &211 ! 212 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , &213 & zfoldwk_2d(jpi,4) , &214 ! 215 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , &209 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , & 210 & foldwk(jpi,4,jpk) , & 211 ! 212 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , & 213 & foldwk_2d(jpi,4) , & 214 ! 215 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , & 216 216 ! 217 217 & STAT=lib_mpp_alloc ) … … 2598 2598 ityp = -1 2599 2599 ijpjm1 = 3 2600 ztab(:,:,:) = 0.e02601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d2600 tab_3d(:,:,:) = 0.e0 2601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d 2603 2603 ij = jj - nlcj + ijpj 2604 znorthloc(:,ij,:) = pt3d(:,jj,:)2604 xnorthloc(:,ij,:) = pt3d(:,jj,:) 2605 2605 END DO 2606 2606 ! 2607 ! ! Build in procs of ncomm_north the znorthgloio2607 ! ! Build in procs of ncomm_north the xnorthgloio 2608 2608 itaille = jpi * jpk * ijpj 2609 2609 IF ( l_north_nogather ) THEN … … 2615 2615 ij = jj - nlcj + ijpj 2616 2616 DO ji = 1, nlci 2617 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2617 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2618 2618 END DO 2619 2619 END DO … … 2640 2640 2641 2641 DO jr = 1,nsndto(ityp) 2642 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2642 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2643 2643 END DO 2644 2644 DO jr = 1,nsndto(ityp) 2645 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))2645 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp)) 2646 2646 iproc = isendto(jr,ityp) + 1 2647 2647 ildi = nldit (iproc) … … 2650 2650 DO jj = 1, ijpj 2651 2651 DO ji = ildi, ilei 2652 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)2652 tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:) 2653 2653 END DO 2654 2654 END DO … … 2665 2665 2666 2666 IF ( ityp .lt. 0 ) THEN 2667 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2668 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2667 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, & 2668 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2669 2669 ! 2670 2670 DO jr = 1, ndim_rank_north ! recover the global north array … … 2675 2675 DO jj = 1, ijpj 2676 2676 DO ji = ildi, ilei 2677 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)2677 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr) 2678 2678 END DO 2679 2679 END DO … … 2681 2681 ENDIF 2682 2682 ! 2683 ! The ztabarray has been either:2683 ! The tab_3d array has been either: 2684 2684 ! a. Fully populated by the mpi_allgather operation or 2685 2685 ! b. Had the active points for this domain and northern neighbours populated … … 2688 2688 ! this domain will be identical. 2689 2689 ! 2690 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2690 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition 2691 2691 ! 2692 2692 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2693 2693 ij = jj - nlcj + ijpj 2694 2694 DO ji= 1, nlci 2695 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)2695 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:) 2696 2696 END DO 2697 2697 END DO … … 2730 2730 ityp = -1 2731 2731 ijpjm1 = 3 2732 ztab_2d(:,:) = 0.e02733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc_2d the last 4 jlines of pt2d2732 tab_2d(:,:) = 0.e0 2733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2d the last 4 jlines of pt2d 2735 2735 ij = jj - nlcj + ijpj 2736 znorthloc_2d(:,ij) = pt2d(:,jj)2736 xnorthloc_2d(:,ij) = pt2d(:,jj) 2737 2737 END DO 2738 2738 2739 ! ! Build in procs of ncomm_north the znorthgloio_2d2739 ! ! Build in procs of ncomm_north the xnorthgloio_2d 2740 2740 itaille = jpi * ijpj 2741 2741 IF ( l_north_nogather ) THEN … … 2747 2747 ij = jj - nlcj + ijpj 2748 2748 DO ji = 1, nlci 2749 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2749 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2750 2750 END DO 2751 2751 END DO … … 2773 2773 2774 2774 DO jr = 1,nsndto(ityp) 2775 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2775 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2776 2776 END DO 2777 2777 DO jr = 1,nsndto(ityp) 2778 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))2778 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp)) 2779 2779 iproc = isendto(jr,ityp) + 1 2780 2780 ildi = nldit (iproc) … … 2783 2783 DO jj = 1, ijpj 2784 2784 DO ji = ildi, ilei 2785 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)2785 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj) 2786 2786 END DO 2787 2787 END DO … … 2798 2798 2799 2799 IF ( ityp .lt. 0 ) THEN 2800 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, &2801 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2800 CALL MPI_ALLGATHER( xnorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2801 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2802 2802 ! 2803 2803 DO jr = 1, ndim_rank_north ! recover the global north array … … 2808 2808 DO jj = 1, ijpj 2809 2809 DO ji = ildi, ilei 2810 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)2810 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr) 2811 2811 END DO 2812 2812 END DO … … 2814 2814 ENDIF 2815 2815 ! 2816 ! The ztab array has been either:2816 ! The tab array has been either: 2817 2817 ! a. Fully populated by the mpi_allgather operation or 2818 2818 ! b. Had the active points for this domain and northern neighbours populated … … 2821 2821 ! this domain will be identical. 2822 2822 ! 2823 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition2823 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition 2824 2824 ! 2825 2825 ! … … 2827 2827 ij = jj - nlcj + ijpj 2828 2828 DO ji = 1, nlci 2829 pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij)2829 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 2830 2830 END DO 2831 2831 END DO … … 2860 2860 ! 2861 2861 ijpj=4 2862 ztab_e(:,:) = 0.e02862 tab_e(:,:) = 0.e0 2863 2863 2864 2864 ij=0 2865 ! put in znorthloc_e the last 4 jlines of pt2d2865 ! put in xnorthloc_e the last 4 jlines of pt2d 2866 2866 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2867 2867 ij = ij + 1 2868 2868 DO ji = 1, jpi 2869 znorthloc_e(ji,ij)=pt2d(ji,jj)2869 xnorthloc_e(ji,ij)=pt2d(ji,jj) 2870 2870 END DO 2871 2871 END DO 2872 2872 ! 2873 2873 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2874 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2875 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2874 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2875 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2876 2876 ! 2877 2877 DO jr = 1, ndim_rank_north ! recover the global north array … … 2882 2882 DO jj = 1, ijpj+2*jpr2dj 2883 2883 DO ji = ildi, ilei 2884 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)2884 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr) 2885 2885 END DO 2886 2886 END DO … … 2890 2890 ! 2. North-Fold boundary conditions 2891 2891 ! ---------------------------------- 2892 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2892 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2893 2893 2894 2894 ij = jpr2dj … … 2897 2897 ij = ij +1 2898 2898 DO ji= 1, nlci 2899 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)2899 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij) 2900 2900 END DO 2901 2901 END DO
Note: See TracChangeset
for help on using the changeset viewer.
