Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/fluxstokenc_p.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3dmem/fluxstokenc_p.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/fluxstokenc_p.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/fluxstokenc_p.f90
r5245 r5246 2 2 ! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $ 3 3 ! 4 c 5 c 6 SUBROUTINE fluxstokenc_p(pbaru,pbarv ,7 *masse, teta, phi)8 USE parallel_lmdz9 10 11 12 13 14 15 4 ! 5 ! 6 SUBROUTINE fluxstokenc_p(pbaru,pbarv , & 7 masse, teta, phi) 8 USE parallel_lmdz 9 USE control_mod, ONLY : iapp_tracvl,planet_type,iphysiq 10 USE caladvtrac_mod 11 USE mod_hallo 12 USE bands 13 USE times 14 USE Vampir 15 USE write_field_loc 16 16 17 c 18 19 c 20 c Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron 21 c 22 c=======================================================================23 c 24 cShema de Van Leer25 c 26 c=======================================================================17 ! 18 IMPLICIT NONE 19 ! 20 ! Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron 21 ! 22 !======================================================================= 23 ! 24 ! Shema de Van Leer 25 ! 26 !======================================================================= 27 27 28 28 29 30 31 29 include "dimensions.h" 30 include "paramet.h" 31 include "tracstoke.h" 32 32 33 cArguments:34 c----------35 36 37 38 39 40 33 ! Arguments: 34 ! ---------- 35 REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm) 36 REAL :: masse(ijb_u:ije_u,llm) 37 REAL :: teta( ijb_u:ije_u,llm) 38 REAL :: phi(ijb_u:ije_u,llm) 39 40 INTEGER,SAVE :: pasflx=0 41 41 !$OMP THREADPRIVATE(pasflx) 42 43 44 42 INTEGER :: ijb,ije,ijbu,ijbv,ijeu,ijev,j 43 INTEGER :: ij,l 44 TYPE(Request),SAVE :: Request_vanleer 45 45 !$OMP THREADPRIVATE(Request_vanleer) 46 46 47 47 48 48 49 !write(*,*) 'caladvtrac 58: entree' 50 ijbu=ij_begin 51 ijeu=ij_end 52 53 ijbv=ij_begin-iip1 54 ijev=ij_end 55 if (pole_nord) ijbv=ij_begin 56 if (pole_sud) ijev=ij_end-iip1 49 ! !write(*,*) 'caladvtrac 58: entree' 50 ijbu=ij_begin 51 ijeu=ij_end 57 52 58 IF(pasflx.EQ.0) THEN 59 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 60 DO l=1,llm 61 tetac(ijbu:ijeu,l)=0. 62 phic(ijbu:ijeu,l)=0. 63 pbarucc(ijbu:ijeu,l)=0. 64 pbarvcc(ijbv:ijev,l)=0. 65 ENDDO 66 c$OMP END DO NOWAIT 67 ENDIF 53 ijbv=ij_begin-iip1 54 ijev=ij_end 55 if (pole_nord) ijbv=ij_begin 56 if (pole_sud) ijev=ij_end-iip1 68 57 69 c accumulation des flux de masse horizontaux 70 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 71 DO l=1,llm 72 DO ij = ijbu,ijeu 73 pbarucc(ij,l) = pbarucc(ij,l) + pbaru(ij,l) 74 tetac(ij,l) = tetac(ij,l) + teta(ij,l) 75 phic(ij,l) = phic(ij,l) + phi(ij,l) 58 IF(pasflx.EQ.0) THEN 59 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 60 DO l=1,llm 61 tetac(ijbu:ijeu,l)=0. 62 phic(ijbu:ijeu,l)=0. 63 pbarucc(ijbu:ijeu,l)=0. 64 pbarvcc(ijbv:ijev,l)=0. 65 ENDDO 66 !$OMP END DO NOWAIT 67 ENDIF 76 68 77 ENDDO 78 DO ij = ijbv,ijev 79 pbarvcc(ij,l) = pbarvcc(ij,l) + pbarv(ij,l) 80 ENDDO 81 ENDDO 82 c$OMP END DO NOWAIT 69 ! accumulation des flux de masse horizontaux 70 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 71 DO l=1,llm 72 DO ij = ijbu,ijeu 73 pbarucc(ij,l) = pbarucc(ij,l) + pbaru(ij,l) 74 tetac(ij,l) = tetac(ij,l) + teta(ij,l) 75 phic(ij,l) = phic(ij,l) + phi(ij,l) 83 76 84 c selection de la masse instantannee des mailles avant le transport. 85 IF(pasflx.EQ.0) THEN 77 ENDDO 78 DO ij = ijbv,ijev 79 pbarvcc(ij,l) = pbarvcc(ij,l) + pbarv(ij,l) 80 ENDDO 81 ENDDO 82 !$OMP END DO NOWAIT 86 83 87 ijb=ij_begin88 ije=ij_end84 ! selection de la masse instantannee des mailles avant le transport. 85 IF(pasflx.EQ.0) THEN 89 86 90 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)91 DO l=1,llm92 massec(ijb:ije,l)=masse(ijb:ije,l)93 ENDDO94 c$OMP END DO NOWAIT95 96 ENDIF97 98 pasflx = pasflx+199 100 101 c Test pour savoir si on advecte a ce pas de temps102 103 IF ( pasflx.EQ.(iphysiq*istphy) ) THEN104 !write(*,*) 'caladvtrac 133'105 c$OMP MASTER106 call suspend_timer(timer_caldyn)107 c$OMP END MASTER108 109 87 ijb=ij_begin 110 88 ije=ij_end 111 89 90 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 91 DO l=1,llm 92 massec(ijb:ije,l)=masse(ijb:ije,l) 93 ENDDO 94 !$OMP END DO NOWAIT 112 95 113 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 114 DO l=1,llm 115 pbarucc(ijb:ije,l) = pbarucc(ijb:ije,l)/REAL(iphysiq*istphy) 116 tetac(ijb:ije,l) = tetac(ijb:ije,l)/REAL(iphysiq*istphy) 117 phic(ijb:ije,l) = phic(ijb:ije,l)/REAL(iphysiq*istphy) 118 ENDDO 119 c$OMP ENDDO NOWAIT 96 ENDIF 120 97 121 if (pole_sud) ije=ij_end-iip1 122 123 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 124 DO l=1,llm 125 pbarvcc(ijb:ije,l) = pbarvcc(ijb:ije,l)/REAL(iphysiq*istphy) 126 ENDDO 127 c$OMP ENDDO NOWAIT 98 pasflx = pasflx+1 128 99 129 100 130 c$OMP BARRIER 131 call Register_Hallo_u(pbarucc,llm,1,1,1,1,Request_vanleer) 132 call Register_Hallo_v(pbarvcc,llm,1,1,1,1,Request_vanleer) 133 call SendRequest(Request_vanleer) 134 c$OMP BARRIER 135 call WaitRequest(Request_vanleer) 136 c$OMP BARRIER 101 ! Test pour savoir si on advecte a ce pas de temps 102 103 IF ( pasflx.EQ.(iphysiq*istphy) ) THEN 104 ! !write(*,*) 'caladvtrac 133' 105 !$OMP MASTER 106 call suspend_timer(timer_caldyn) 107 !$OMP END MASTER 108 109 ijb=ij_begin 110 ije=ij_end 111 112 113 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 114 DO l=1,llm 115 pbarucc(ijb:ije,l) = pbarucc(ijb:ije,l)/REAL(iphysiq*istphy) 116 tetac(ijb:ije,l) = tetac(ijb:ije,l)/REAL(iphysiq*istphy) 117 phic(ijb:ije,l) = phic(ijb:ije,l)/REAL(iphysiq*istphy) 118 ENDDO 119 !$OMP ENDDO NOWAIT 120 121 if (pole_sud) ije=ij_end-iip1 122 123 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 124 DO l=1,llm 125 pbarvcc(ijb:ije,l) = pbarvcc(ijb:ije,l)/REAL(iphysiq*istphy) 126 ENDDO 127 !$OMP ENDDO NOWAIT 128 129 130 !$OMP BARRIER 131 call Register_Hallo_u(pbarucc,llm,1,1,1,1,Request_vanleer) 132 call Register_Hallo_v(pbarvcc,llm,1,1,1,1,Request_vanleer) 133 call SendRequest(Request_vanleer) 134 !$OMP BARRIER 135 call WaitRequest(Request_vanleer) 136 !$OMP BARRIER 137 137 138 138 139 139 140 141 cc .. Modif P.Le Van ( 20/12/97 ) ....142 cc143 140 144 c traitement des flux de masse avant advection. 145 c 1. calcul de w 146 c 2. groupement des mailles pres du pole. 141 !c .. Modif P.Le Van ( 20/12/97 ) .... 142 !c 147 143 148 CALL groupe_loc( massec, pbarucc,pbarvcc, pbarugg,pbarvgg,wgg ) 144 ! traitement des flux de masse avant advection. 145 ! 1. calcul de w 146 ! 2. groupement des mailles pres du pole. 147 148 CALL groupe_loc( massec, pbarucc,pbarvcc, pbarugg,pbarvgg,wgg ) 149 149 150 150 151 151 152 153 152 ijb=ij_begin 153 ije=ij_end 154 154 155 c$OMP BARRIER156 157 158 159 160 161 155 !$OMP BARRIER 156 CALL WriteField_u('pbarug',pbarugg) 157 CALL WriteField_v('pbarvg',pbarvgg) 158 CALL WriteField_u('wg',wgg) 159 CALL WriteField_u('tetag',tetac) 160 CALL WriteField_u('phig',phic) 161 CALL WriteField_u('masseg',massec) 162 162 163 163 164 c$OMP MASTER165 166 167 168 c$OMP END MASTER164 !$OMP MASTER 165 call Set_Distrib(distrib_caldyn) 166 call VTe(VThallo) 167 call resume_timer(timer_caldyn) 168 !$OMP END MASTER 169 169 170 170 171 c$OMP BARRIER172 173 171 !$OMP BARRIER 172 pasflx=0 173 ENDIF ! if iadvtr.EQ.iapp_tracvl 174 174 175 END 175 END SUBROUTINE fluxstokenc_p
Note: See TracChangeset
for help on using the changeset viewer.
