Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/groupe_loc.F90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3dmem/groupe_loc.F90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/groupe_loc.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/groupe_loc.F90
r5245 r5246 1 2 3 4 5 6 1 subroutine groupe_loc(pext,pbaru,pbarv,pbarum,pbarvm,wm) 2 USE parallel_lmdz 3 USE Write_field_loc 4 USE groupe_mod 5 USE comconst_mod, ONLY: ngroup 6 implicit none 7 7 8 csous-programme servant a fitlrer les champs de flux de masse aux9 cpoles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur10 cet a mesure qu'on se rapproche du pole.11 c 12 cen entree: pext, pbaru et pbarv13 c 14 cen sortie: pbarum,pbarvm et wm.15 c 16 cremarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc17 cpas besoin de w en entree.8 ! sous-programme servant a fitlrer les champs de flux de masse aux 9 ! poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur 10 ! et a mesure qu'on se rapproche du pole. 11 ! 12 ! en entree: pext, pbaru et pbarv 13 ! 14 ! en sortie: pbarum,pbarvm et wm. 15 ! 16 ! remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc 17 ! pas besoin de w en entree. 18 18 19 20 21 19 include "dimensions.h" 20 include "paramet.h" 21 include "comgeom2.h" 22 22 23 !integer ngroup24 !parameter (ngroup=3)23 ! integer ngroup 24 ! parameter (ngroup=3) 25 25 26 26 27 realpbaru(iip1,jjb_u:jje_u,llm),pbarv(iip1,jjb_v:jje_v,llm)28 realpext(iip1,jjb_u:jje_u,llm)27 real :: pbaru(iip1,jjb_u:jje_u,llm),pbarv(iip1,jjb_v:jje_v,llm) 28 real :: pext(iip1,jjb_u:jje_u,llm) 29 29 30 realpbarum(iip1,jjb_u:jje_u,llm),pbarvm(iip1,jjb_v:jje_v,llm)31 realwm(iip1,jjb_u:jje_u,llm)30 real :: pbarum(iip1,jjb_u:jje_u,llm),pbarvm(iip1,jjb_v:jje_v,llm) 31 real :: wm(iip1,jjb_u:jje_u,llm) 32 32 33 33 34 realuu34 real :: uu 35 35 36 integeri,j,l36 integer :: i,j,l 37 37 38 logicalfirstcall39 40 c$OMP THREADPRIVATE(firstcall)38 logical :: firstcall 39 save firstcall 40 !$OMP THREADPRIVATE(firstcall) 41 41 42 integer ijb,ije,jjb,jje 43 44 c Champs 1D 42 integer :: ijb,ije,jjb,jje 45 43 46 call convflu_loc(pbaru,pbarv,llm,zconvm)44 ! Champs 1D 47 45 48 c 49 c call scopy(ijp1llm,zconvm,1,zconvmm,1) 50 c call scopy(ijmllm,pbarv,1,pbarvm,1) 51 52 jjb=jj_begin 53 jje=jj_end 46 call convflu_loc(pbaru,pbarv,llm,zconvm) 54 47 55 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 56 do l=1,llm 57 zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l) 58 enddo 59 c$OMP END DO NOWAIT 48 ! 49 ! call scopy(ijp1llm,zconvm,1,zconvmm,1) 50 ! call scopy(ijmllm,pbarv,1,pbarvm,1) 60 51 61 call groupeun_loc(jjp1,llm,jjb_u,jje_u,jjb,jje,zconvmm) 62 63 jjb=jj_begin-1 64 jje=jj_end 65 if (pole_nord) jjb=jj_begin 66 if (pole_sud) jje=jj_end-1 67 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 68 do l=1,llm 69 pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l) 70 enddo 71 c$OMP END DO NOWAIT 52 jjb=jj_begin 53 jje=jj_end 72 54 73 #ifdef DEBUG_IO 74 CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/))) 55 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 56 do l=1,llm 57 zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l) 58 enddo 59 !$OMP END DO NOWAIT 60 61 call groupeun_loc(jjp1,llm,jjb_u,jje_u,jjb,jje,zconvmm) 62 63 jjb=jj_begin-1 64 jje=jj_end 65 if (pole_nord) jjb=jj_begin 66 if (pole_sud) jje=jj_end-1 67 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 68 do l=1,llm 69 pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l) 70 enddo 71 !$OMP END DO NOWAIT 72 73 #ifdef DEBUG_IO 74 CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/))) 75 75 #endif 76 77 #ifdef DEBUG_IO 78 76 call groupeun_loc(jjm,llm,jjb_v,jje_v,jjb,jje,pbarvm) 77 #ifdef DEBUG_IO 78 CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/))) 79 79 #endif 80 c Champs 3D 81 82 jjb=jj_begin 83 jje=jj_end 84 if (pole_nord) jjb=jj_begin+1 85 if (pole_sud) jje=jj_end-1 86 87 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 88 do l=1,llm 89 do j=jjb,jje 90 uu=pbaru(iim,j,l) 91 do i=1,iim 92 uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l) 93 pbarum(i,j,l)=uu 94 c zconvm(i,j,l ) = xflu(i-1,j,l)-xflu(i,j,l)+ 95 c * yflu(i,j,l)-yflu(i,j-1,l) 96 enddo 97 pbarum(iip1,j,l)=pbarum(1,j,l) 80 ! Champs 3D 81 82 jjb=jj_begin 83 jje=jj_end 84 if (pole_nord) jjb=jj_begin+1 85 if (pole_sud) jje=jj_end-1 86 87 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 88 do l=1,llm 89 do j=jjb,jje 90 uu=pbaru(iim,j,l) 91 do i=1,iim 92 uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l) 93 pbarum(i,j,l)=uu 94 ! zconvm(i,j,l ) = xflu(i-1,j,l)-xflu(i,j,l)+ 95 ! * yflu(i,j,l)-yflu(i,j-1,l) 96 enddo 97 pbarum(iip1,j,l)=pbarum(1,j,l) 98 enddo 99 enddo 100 !$OMP END DO NOWAIT 101 ! integration de la convergence de masse de haut en bas ...... 102 103 jjb=jj_begin 104 jje=jj_end 105 106 !$OMP BARRIER 107 !$OMP MASTER 108 do l = llm-1,1,-1 109 do j=jjb,jje 110 do i=1,iip1 111 zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1) 98 112 enddo 99 113 enddo 100 c$OMP END DO NOWAIT 101 c integration de la convergence de masse de haut en bas ...... 102 103 jjb=jj_begin 104 jje=jj_end 114 enddo 105 115 106 c$OMP BARRIER 107 c$OMP MASTER 108 do l = llm-1,1,-1 109 do j=jjb,jje 110 do i=1,iip1 111 zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1) 112 enddo 113 enddo 114 enddo 116 if (.not. pole_sud) then 117 zconvmm(:,jj_end+1,:)=0 118 !ym wm(:,jj_end+1,:)=0 119 endif 115 120 116 if (.not. pole_sud) then 117 zconvmm(:,jj_end+1,:)=0 118 cym wm(:,jj_end+1,:)=0 119 endif 120 121 c$OMP END MASTER 122 c$OMP BARRIER 121 !$OMP END MASTER 122 !$OMP BARRIER 123 123 124 124 CALL vitvert_loc(zconvmm,wm) 125 125 126 127 end 126 return 127 end subroutine groupe_loc 128 128
Note: See TracChangeset
for help on using the changeset viewer.
