Changeset 4368 for LMDZ6/branches/Ocean_skin/libf/dyn3d/vlspltqs.F
- Timestamp:
- Dec 6, 2022, 12:01:16 AM (22 months ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/dyn3d/vlspltqs.F (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/dyn3d/vlspltqs.F
r2603 r4368 4 4 SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt, 5 5 , p,pk,teta,iq ) 6 USE infotrac, ONLY: nqtot, nqdesc,iqfils6 USE infotrac, ONLY: nqtot,tracers 7 7 c 8 8 c Auteurs: P.Le Van, F.Hourdin, F.Forget, F.Codron … … 121 121 CALL SCOPY(ijp1llm,q(1,1,iq),1,zq(1,1,iq),1) 122 122 CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1) 123 if (nqdesc(iq).gt.0) then 124 do ifils=1,nqdesc(iq) 125 iq2=iqfils(ifils,iq) 123 do ifils=1,tracers(iq)%nqDescen 124 iq2=tracers(iq)%iqDescen(ifils) 126 125 CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1) 127 enddo 128 endif !if (nqfils(iq).gt.0) then 126 enddo 129 127 130 128 c call minmaxq(zq,qmin,qmax,'avant vlxqs ') … … 162 160 ENDDO 163 161 ! CRisi: aussi pour les fils 164 if (nqdesc(iq).gt.0) then 165 do ifils=1,nqdesc(iq) 166 iq2=iqfils(ifils,iq) 162 do ifils=1,tracers(iq)%nqDescen 163 iq2=tracers(iq)%iqDescen(ifils) 167 164 DO l=1,llm 168 DO ij=1,ip1jmp1169 q(ij,l,iq2)=zq(ij,l,iq2)170 ENDDO171 DO ij=1,ip1jm+1,iip1165 DO ij=1,ip1jmp1 166 q(ij,l,iq2)=zq(ij,l,iq2) 167 ENDDO 168 DO ij=1,ip1jm+1,iip1 172 169 q(ij+iim,l,iq2)=q(ij,l,iq2) 173 ENDDO170 ENDDO 174 171 ENDDO 175 enddo !do ifils=1,nqdesc(iq) 176 endif ! if (nqfils(iq).gt.0) then 172 enddo 177 173 !write(*,*) 'vlspltqs 183: fin de la routine' 178 174 … … 180 176 END 181 177 SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat,iq) 182 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils ! CRisi178 USE infotrac, ONLY : nqtot,tracers ! CRisi 183 179 184 180 c … … 483 479 ! CRisi: appel récursif de l'advection sur les fils. 484 480 ! Il faut faire ça avant d'avoir mis à jour q et masse 485 !write(*,*) 'vlspltqs 326: iq,nqfils(iq)=',iq,nqfils(iq) 481 !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq, 482 ! & tracers(iq)%nqChildren 486 483 487 if (nqfils(iq).gt.0) then 488 do ifils=1,nqdesc(iq) 489 iq2=iqfils(ifils,iq) 490 DO l=1,llm 484 do ifils=1,tracers(iq)%nqDescen 485 iq2=tracers(iq)%iqDescen(ifils) 486 DO l=1,llm 491 487 DO ij=iip2,ip1jm 492 493 masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)494 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)488 ! On a besoin de q et masse seulement entre iip2 et ip1jm 489 masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq) 490 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 495 491 enddo 496 enddo 497 enddo !do ifils=1,nqdesc(iq) 498 do ifils=1,nqfils(iq) 499 iq2=iqfils(ifils,iq) 500 call vlx(Ratio,pente_max,masseq,u_mq,iq2) 501 enddo !do ifils=1,nqfils(iq) 502 endif !if (nqfils(iq).gt.0) then 492 enddo 493 enddo 494 do ifils=1,tracers(iq)%nqChildren 495 iq2=tracers(iq)%iqDescen(ifils) 496 call vlx(Ratio,pente_max,masseq,u_mq,iq2) 497 enddo 503 498 ! end CRisi 504 499 … … 523 518 ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio 524 519 ! puis on boucle en longitude 525 if (nqdesc(iq).gt.0) then 526 do ifils=1,nqdesc(iq) 527 iq2=iqfils(ifils,iq) 528 DO l=1,llm 520 do ifils=1,tracers(iq)%nqDescen 521 iq2=tracers(iq)%iqDescen(ifils) 522 DO l=1,llm 529 523 DO ij=iip2+1,ip1jm 530 524 q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2) 531 525 enddo 532 526 DO ij=iip1+iip1,ip1jm,iip1 533 q(ij-iim,l,iq2)=q(ij,l,iq2) 534 enddo ! DO ij=ijb+iip1-1,ije,iip1 535 enddo !DO l=1,llm 536 enddo !do ifils=1,nqdesc(iq) 537 endif !if (nqfils(iq).gt.0) then 527 q(ij-iim,l,iq2)=q(ij,l,iq2) 528 enddo 529 enddo 530 enddo 538 531 539 532 c CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1) … … 544 537 END 545 538 SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat,iq) 546 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils ! CRisi539 USE infotrac, ONLY : nqtot,tracers ! CRisi 547 540 c 548 541 c Auteurs: P.Le Van, F.Hourdin, F.Forget … … 794 787 ! CRisi: appel récursif de l'advection sur les fils. 795 788 ! Il faut faire ça avant d'avoir mis à jour q et masse 796 !write(*,*) 'vlyqs 689: iq,nqfils(iq)=',iq,nqfils(iq) 789 !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq, 790 ! & tracers(iq)%nqChildren 797 791 798 if (nqfils(iq).gt.0) then 799 do ifils=1,nqdesc(iq) 800 iq2=iqfils(ifils,iq) 801 DO l=1,llm 802 DO ij=1,ip1jmp1 803 masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq) 804 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 792 do ifils=1,tracers(iq)%nqDescen 793 iq2=tracers(iq)%iqDescen(ifils) 794 DO l=1,llm 795 DO ij=1,ip1jmp1 796 masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq) 797 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 805 798 enddo 806 enddo 807 enddo !do ifils=1,nqdesc(iq) 808 809 do ifils=1,nqfils(iq) 810 iq2=iqfils(ifils,iq) 811 !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2 812 call vly(Ratio,pente_max,masseq,qbyv,iq2) 813 enddo !do ifils=1,nqfils(iq) 814 endif !if (nqfils(iq).gt.0) then 799 enddo 800 enddo 801 do ifils=1,tracers(iq)%nqChildren 802 iq2=tracers(iq)%iqDescen(ifils) 803 !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2 804 call vly(Ratio,pente_max,masseq,qbyv,iq2) 805 enddo 815 806 816 807 DO l=1,llm … … 868 859 869 860 ! retablir les fils en rapport de melange par rapport a l'air: 870 if (nqdesc(iq).gt.0) then 871 do ifils=1,nqdesc(iq) 872 iq2=iqfils(ifils,iq) 873 DO l=1,llm 861 do ifils=1,tracers(iq)%nqDescen 862 iq2=tracers(iq)%iqDescen(ifils) 863 DO l=1,llm 874 864 DO ij=1,ip1jmp1 875 865 q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2) 876 866 enddo 877 enddo 878 enddo !do ifils=1,nqdesc(iq) 879 endif !if (nqfils(iq).gt.0) then 867 enddo 868 enddo 880 869 !write(*,*) 'vly 879' 881 870
Note: See TracChangeset
for help on using the changeset viewer.
