Changeset 4171 for LMDZ6/branches/LMDZ-ECRAD/libf/dyn3dmem/vlsplt_loc.F
- Timestamp:
- Jun 17, 2022, 4:24:49 PM (2 years ago)
- Location:
- LMDZ6/branches/LMDZ-ECRAD
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-ECRAD
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ-ECRAD/libf/dyn3dmem/vlsplt_loc.F
r3800 r4171 14 14 c -------------------------------------------------------------------- 15 15 USE parallel_lmdz 16 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils, ! CRisi &17 & qperemin,masseqmin,ratiomin! MVals et CRisi16 USE infotrac, ONLY : nqtot,tracers, ! CRisi & 17 & min_qParent,min_qMass,min_ratio ! MVals et CRisi 18 18 IMPLICIT NONE 19 19 c … … 330 330 ! Il faut faire ça avant d'avoir mis à jour q et masse 331 331 332 if (nqfils(iq).gt.0) then 333 do ifils=1,nqdesc(iq) 334 !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020 332 do ifils=1,tracers(iq)%nqDescen 335 333 ! attention: comme Ratio est utilisé comme q dans l'appel 336 334 ! recursif, il doit contenir à lui seul tous les indices de tous 337 335 ! les descendants! 338 iq2=iqfils(ifils,iq)339 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 340 336 iq2=tracers(iq)%iqDescen(ifils) 337 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 338 DO l=1,llm 341 339 DO ij=ijb,ije 342 ! On a besoin de q et masse seulement entre ijb et ije. On ne343 ! les calcule donc que de ijb à ije344 !MVals: veiller a ce qu'on n'ait pas de denominateur nul345 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)346 if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020347 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)348 else349 Ratio(ij,l,iq2)=ratiomin350 endif340 ! On a besoin de q et masse seulement entre ijb et ije. On ne 341 ! les calcule donc que de ijb à ije 342 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 343 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 344 if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020 345 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 346 else 347 Ratio(ij,l,iq2)=min_ratio 348 endif 351 349 enddo 352 enddo 353 c$OMP END DO NOWAIT 354 enddo !do ifils=1,nqdesc(iq) 355 do ifils=1,nqfils(iq) 356 iq2=iqfils(ifils,iq) 357 call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2) 358 enddo !do ifils=1,nqfils(iq) 359 endif !if (nqfils(iq).gt.0) then 350 enddo 351 c$OMP END DO NOWAIT 352 enddo !do ifils=1,tracers(iq)%nqDescen 353 do ifils=1,tracers(iq)%nqChilds 354 iq2=tracers(iq)%iqDescen(ifils) 355 call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2) 356 enddo 360 357 ! end CRisi 361 358 … … 366 363 DO ij=ijb+1,ije 367 364 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 368 new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),m asseqmin)365 new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),min_qMass) 369 366 q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+ 370 367 & u_mq(ij-1,l)-u_mq(ij,l)) … … 383 380 ! On calcule q entre ijb+1 et ije -> on fait pareil pour ratio 384 381 ! puis on boucle en longitude 385 if (nqfils(iq).gt.0) then 386 do ifils=1,nqdesc(iq) 387 !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020 388 iq2=iqfils(ifils,iq) 382 do ifils=1,tracers(iq)%nqDescen 383 iq2=tracers(iq)%iqDescen(ifils) 389 384 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 390 385 DO l=1,llm 391 386 DO ij=ijb+1,ije 392 387 q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2) 393 388 enddo 394 389 DO ij=ijb+iip1-1,ije,iip1 395 q(ij-iim,l,iq2)=q(ij,l,iq2) 396 enddo ! DO ij=ijb+iip1-1,ije,iip1 397 enddo !DO l=1,llm 398 c$OMP END DO NOWAIT 399 enddo !do ifils=1,nqdesc(iq) 400 endif !if (nqfils(iq).gt.0) then 390 q(ij-iim,l,iq2)=q(ij,l,iq2) 391 enddo 392 enddo 393 c$OMP END DO NOWAIT 394 enddo 401 395 402 396 !write(*,*) 'vlsplt 399: iq,ijb_x=',iq,ijb_x … … 422 416 c -------------------------------------------------------------------- 423 417 USE parallel_lmdz 424 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils, ! CRisi &425 & qperemin,masseqmin,ratiomin! MVals et CRisi418 USE infotrac, ONLY : nqtot,tracers, ! CRisi & 419 & min_qParent,min_qMass,min_ratio ! MVals et CRisi 426 420 USE comconst_mod, ONLY: pi 427 421 IMPLICIT NONE … … 732 726 ! CRisi: appel récursif de l'advection sur les fils. 733 727 ! Il faut faire ça avant d'avoir mis à jour q et masse 734 !write(*,*) 'vly 689: iq,nq fils(iq)=',iq,nqfils(iq)728 !write(*,*) 'vly 689: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds 735 729 736 730 ijb=ij_begin-2*iip1 … … 743 737 if (pole_sud) ijem=ij_end 744 738 745 if (nqfils(iq).gt.0) then 746 do ifils=1,nqdesc(iq) 747 !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020 748 iq2=iqfils(ifils,iq) 739 do ifils=1,tracers(iq)%nqDescen 740 iq2=tracers(iq)%iqDescen(ifils) 749 741 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 750 751 752 742 DO l=1,llm 743 ! modif des bornes: CRisi 16 nov 2020 744 ! d'abord masse avec bornes corrigées 753 745 DO ij=ijbm,ijem 754 755 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)756 enddo !DO ij=ijbm,ijem746 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 747 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 748 enddo 757 749 758 750 ! ensuite Ratio avec anciennes bornes 759 DO ij=ijb,ije760 761 if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020762 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)763 else764 Ratio(ij,l,iq2)=ratiomin765 endif751 DO ij=ijb,ije 752 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 753 if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020 754 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 755 else 756 Ratio(ij,l,iq2)=min_ratio 757 endif 766 758 enddo !DO ij=ijbm,ijem 767 enddo !DO l=1,llm 768 c$OMP END DO NOWAIT 769 enddo !do ifils=1,nqdesc(iq) 770 771 do ifils=1,nqfils(iq) 772 iq2=iqfils(ifils,iq) 773 call vly_loc(Ratio,pente_max,masse,qbyv,iq2) 774 enddo !do ifils=1,nqfils(iq) 775 endif !if (nqfils(iq).gt.0) then 759 enddo !DO l=1,llm 760 c$OMP END DO NOWAIT 761 enddo 762 763 do ifils=1,tracers(iq)%nqChilds 764 iq2=tracers(iq)%iqDescen(ifils) 765 call vly_loc(Ratio,pente_max,masse,qbyv,iq2) 766 enddo 776 767 ! end CRisi 777 768 … … 862 853 ! if (pole_sud) ije=ij_end 863 854 864 if (nqfils(iq).gt.0) then 865 do ifils=1,nqdesc(iq) 866 iq2=iqfils(ifils,iq) 855 do ifils=1,tracers(iq)%nqDescen 856 iq2=tracers(iq)%iqDescen(ifils) 867 857 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 868 858 DO l=1,llm 869 859 DO ij=ijb,ije 870 860 q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2) 871 861 enddo 872 enddo 873 c$OMP END DO NOWAIT 874 enddo !do ifils=1,nqdesc(iq) 875 endif !if (nqfils(iq).gt.0) then 862 enddo 863 c$OMP END DO NOWAIT 864 enddo 876 865 877 866 … … 895 884 USE parallel_lmdz 896 885 USE vlz_mod 897 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils, ! CRisi &898 & qperemin,masseqmin,ratiomin! MVals et CRisi886 USE infotrac, ONLY : nqtot,tracers, ! CRisi & 887 & min_qParent,min_qMass,min_ratio ! MVals et CRisi 899 888 900 889 IMPLICIT NONE … … 1085 1074 ENDDO 1086 1075 ENDDO 1087 c$OMP END DO NO 1076 c$OMP END DO NOWAIT 1088 1077 1089 1078 c Reindicage vertical en accumulant les flux sur … … 1125 1114 ENDDO 1126 1115 ENDDO 1127 c$OMP END DO NO 1116 c$OMP END DO NOWAIT 1128 1117 1129 1118 ENDDO ! WHILE (countcfl>=1) … … 1159 1148 ! CRisi: appel récursif de l'advection sur les fils. 1160 1149 ! Il faut faire ça avant d'avoir mis à jour q et masse 1161 !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq) 1162 if (nqfils(iq).gt.0) then 1163 do ifils=1,nqdesc(iq) 1164 !do ifils=1,nqfils(iq) ! modif C Risi 22 nov 2020 1165 iq2=iqfils(ifils,iq) 1166 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1167 DO l=1,llm 1150 !write(*,*) 'vlsplt 942: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds 1151 do ifils=1,tracers(iq)%nqDescen 1152 iq2=tracers(iq)%iqDescen(ifils) 1153 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1154 DO l=1,llm 1168 1155 DO ij=ijb,ije 1169 1156 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 1170 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)1171 if (q(ij,l,iq).gt.qperemin) then1172 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)1173 else1174 Ratio(ij,l,iq2)=ratiomin1175 endif1176 !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai20151177 w(ij,l,iq2)=wq(ij,l,iq)1157 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 1158 if (q(ij,l,iq).gt.min_qParent) then 1159 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 1160 else 1161 Ratio(ij,l,iq2)=min_ratio 1162 endif 1163 !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015 1164 w(ij,l,iq2)=wq(ij,l,iq) 1178 1165 enddo 1179 1180 c$OMP END DO NOWAIT 1181 enddo !do ifils=1,nqdesc(iq)1166 enddo 1167 c$OMP END DO NOWAIT 1168 enddo 1182 1169 c$OMP BARRIER 1183 1170 1184 do ifils=1,nqfils(iq) 1185 iq2=iqfils(ifils,iq) 1186 call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2) 1187 enddo !do ifils=1,nqfils(iq) 1188 endif !if (nqfils(iq).gt.0) then 1171 do ifils=1,tracers(iq)%nqChilds 1172 iq2=tracers(iq)%iqDescen(ifils) 1173 call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2) 1174 enddo 1189 1175 ! end CRisi 1190 1176 … … 1207 1193 1208 1194 ! retablir les fils en rapport de melange par rapport a l'air: 1209 if (nqfils(iq).gt.0) then 1210 do ifils=1,nqdesc(iq) 1211 iq2=iqfils(ifils,iq) 1195 do ifils=1,tracers(iq)%nqDescen 1196 iq2=tracers(iq)%iqDescen(ifils) 1212 1197 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1213 1198 DO l=1,llm 1214 1199 DO ij=ijb,ije 1215 1200 q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2) 1216 1201 enddo 1217 enddo 1218 c$OMP END DO NOWAIT 1219 enddo !do ifils=1,nqdesc(iq) 1220 endif !if (nqfils(iq).gt.0) then 1202 enddo 1203 c$OMP END DO NOWAIT 1204 enddo 1221 1205 1222 1206 RETURN
Note: See TracChangeset
for help on using the changeset viewer.