Changeset 3852 for LMDZ6/branches/LMDZ-tracers/libf/dyn3d/vlsplt.F
- Timestamp:
- Feb 22, 2021, 5:28:31 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-tracers/libf/dyn3d/vlsplt.F
r2603 r3852 4 4 5 5 SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt,iq) 6 USE infotrac, ONLY: nqtot, nqdesc,iqfils6 USE infotrac, ONLY: nqtot, tracers, tra 7 7 c 8 8 c Auteurs: P.Le Van, F.Hourdin, F.Forget … … 54 54 SAVE temps1,temps2,temps3 55 55 INTEGER iminn,imaxx 56 INTEGER ifils,iq2 ! CRisi 56 INTEGER ichld,iq2 ! CRisi 57 TYPE(tra), POINTER :: tr 57 58 58 59 REAL qmin,qmax … … 61 62 DATA temps1,temps2,temps3/0.,0.,0./ 62 63 64 tr => tracers(iq) 63 65 64 66 zzpbar = 0.5 * pdt … … 83 85 CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1) 84 86 85 if ( nqdesc(iq).gt.0) then86 do i fils=1,nqdesc(iq)87 iq2= iqfils(ifils,iq)87 if (tr%ndesc > 0) then 88 do ichld=1,tr%ndesc 89 iq2=tr%idesc(ichld) 88 90 CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1) 89 91 enddo 90 endif !if ( nqfils(iq).gt.0) then92 endif !if (tr%ndesc > 0) then 91 93 92 94 cprint*,'Entree vlx1' … … 122 124 ENDDO 123 125 ! CRisi: aussi pour les fils 124 if (nqdesc(iq).gt.0) then125 do i fils=1,nqdesc(iq)126 iq2= iqfils(ifils,iq)126 if(tr%ndesc > 0) then 127 do ichld=1,tr%ndesc 128 iq2=tr%idesc(ichld) 127 129 DO l=1,llm 128 130 DO ij=1,ip1jmp1 … … 133 135 ENDDO 134 136 ENDDO 135 enddo !do i fils=1,nqdesc(iq)136 endif ! if ( nqdesc(iq).gt.0) then137 enddo !do ichld=1,tr%ndesc 138 endif ! if (tr%ndesc > 0) 137 139 138 140 RETURN 139 141 END 140 142 RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq) 141 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils! CRisi143 USE infotrac, ONLY : nqtot, tracers, tra ! CRisi 142 144 143 145 c Auteurs: P.Le Van, F.Hourdin, F.Forget … … 179 181 ! CRisi 180 182 REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) 181 INTEGER ifils,iq2 ! CRisi 183 INTEGER ichld,iq2 ! CRisi 184 TYPE(tra), POINTER :: tr 182 185 183 186 Logical extremum,first,testcpu … … 200 203 first=.false. 201 204 ENDIF 205 206 tr => tracers(iq) 202 207 203 208 c calcul de la pente a droite et a gauche de la maille … … 450 455 !write(*,*) 'vlsplt 326: iq,nqfils(iq)=',iq,nqfils(iq) 451 456 452 if ( nqdesc(iq).gt.0) then453 do i fils=1,nqdesc(iq)454 iq2= iqfils(ifils,iq)457 if (tr%ndesc > 0) then 458 do ichld=1,tr%ndesc 459 iq2=tr%idesc(ichld) 455 460 DO l=1,llm 456 461 DO ij=iip2,ip1jm … … 460 465 enddo 461 466 enddo 462 enddo !do i fils=1,nqdesc(iq)463 do i fils=1,nqfils(iq)464 iq2= iqfils(ifils,iq)467 enddo !do ichld=1,tr%ndesc 468 do ichld=1,tr%nchld 469 iq2=tr%idesc(ichld) 465 470 call vlx(Ratio,pente_max,masseq,u_mq,iq2) 466 enddo !do i fils=1,nqfils(iq)467 endif !if ( nqfils(iq).gt.0) then471 enddo !do ichld=1,tr%nchld 472 endif !if (tr%nchld > 0) then 468 473 ! end CRisi 469 474 … … 489 494 ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio 490 495 ! puis on boucle en longitude 491 if ( nqdesc(iq).gt.0) then492 do i fils=1,nqdesc(iq)493 iq2= iqfils(ifils,iq)496 if (tr%ndesc > 0) then 497 do ichld=1,tr%ndesc 498 iq2=tr%idesc(ichld) 494 499 DO l=1,llm 495 500 DO ij=iip2+1,ip1jm … … 500 505 enddo ! DO ij=ijb+iip1-1,ije,iip1 501 506 enddo !DO l=1,llm 502 enddo !do i fils=1,nqdesc(iq)503 endif !if ( nqfils(iq).gt.0) then507 enddo !do ichld=1,tr%ndesc 508 endif !if (tr%ndesc > 0) then 504 509 505 510 c CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1) … … 510 515 END 511 516 RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq) 512 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils! CRisi517 USE infotrac, ONLY : nqtot, tracers, tra ! CRisi 513 518 c 514 519 c Auteurs: P.Le Van, F.Hourdin, F.Forget … … 562 567 563 568 REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi 564 INTEGER i fils,iq2 ! CRisi565 569 INTEGER ichld,iq2 ! CRisi 570 TYPE(tra), POINTER :: tr 566 571 c 567 572 c … … 590 595 ENDIF 591 596 597 tr => tracers(iq) 592 598 c 593 599 cPRINT*,'CALCUL EN LATITUDE' … … 770 776 !write(*,*) 'vly 689: iq,nqfils(iq)=',iq,nqfils(iq) 771 777 772 if ( nqfils(iq).gt.0) then773 do i fils=1,nqdesc(iq)774 iq2= iqfils(ifils,iq)778 if (tr%ndesc > 0) then 779 do ichld=1,tr%ndesc 780 iq2=tr%idesc(ichld) 775 781 DO l=1,llm 776 782 DO ij=1,ip1jmp1 … … 781 787 enddo 782 788 enddo 783 enddo !do i fils=1,nqdesc(iq)784 785 do i fils=1,nqfils(iq)786 iq2= iqfils(ifils,iq)789 enddo !do ichld=1,tr%ndesc 790 791 do ichld=1,tr%nchld 792 iq2=tr%idesc(ichld) 787 793 call vly(Ratio,pente_max,masseq,qbyv,iq2) 788 enddo !do i fils=1,nqfils(iq)789 endif !if ( nqfils(iq).gt.0) then794 enddo !do ichld=1,tr%nchld 795 endif !if (tr%ndesc > 0) 790 796 791 797 DO l=1,llm … … 855 861 856 862 ! retablir les fils en rapport de melange par rapport a l'air: 857 if ( nqfils(iq).gt.0) then858 do i fils=1,nqdesc(iq)859 iq2= iqfils(ifils,iq)863 if (tr%ndesc > 0) then 864 do ichld=1,tr%ndesc 865 iq2=tr%idesc(ichld) 860 866 DO l=1,llm 861 867 DO ij=1,ip1jmp1 … … 863 869 enddo 864 870 enddo 865 enddo !do i fils=1,nqdesc(iq)866 endif !if ( nqfils(iq).gt.0) then871 enddo !do ichld=1,tr%ndesc 872 endif !if (tr%ndesc > 0) 867 873 868 874 !write(*,*) 'vly 853: sortie' … … 871 877 END 872 878 RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq) 873 USE infotrac, ONLY : nqtot, nqfils,nqdesc,iqfils! CRisi879 USE infotrac, ONLY : nqtot, tracers, tra ! CRisi 874 880 c 875 881 c Auteurs: P.Le Van, F.Hourdin, F.Forget … … 907 913 908 914 REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi 909 INTEGER ifils,iq2 ! CRisi 915 INTEGER ichld,iq2 ! CRisi 916 TYPE(tra), POINTER :: tr 910 917 911 918 LOGICAL testcpu … … 923 930 924 931 !write(*,*) 'vlz 923: entree' 932 933 tr => tracers(iq) 925 934 926 935 #ifdef BIDON … … 992 1001 ! Il faut faire ça avant d'avoir mis à jour q et masse 993 1002 !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq) 994 if ( nqfils(iq).gt.0) then995 do i fils=1,nqdesc(iq)996 iq2= iqfils(ifils,iq)1003 if (tr%ndesc > 0) then 1004 do ichld=1,tr%ndesc 1005 iq2=tr%idesc(ichld) 997 1006 DO l=1,llm 998 1007 DO ij=1,ip1jmp1 … … 1001 1010 enddo 1002 1011 enddo 1003 enddo !do i fils=1,nqdesc(iq)1012 enddo !do ichld=1,tr%ndesc 1004 1013 1005 do i fils=1,nqfils(iq)1006 iq2= iqfils(ifils,iq)1014 do ichld=1,tr%nchld 1015 iq2=tr%idesc(ichld) 1007 1016 call vlz(Ratio,pente_max,masseq,wq,iq2) 1008 enddo !do i fils=1,nqfils(iq)1009 endif !if ( nqfils(iq).gt.0) then1017 enddo !do ichld=1,tr%nchld 1018 endif !if (tr%ndesc > 0) 1010 1019 ! end CRisi 1011 1020 … … 1020 1029 1021 1030 ! retablir les fils en rapport de melange par rapport a l'air: 1022 if ( nqfils(iq).gt.0) then1023 do i fils=1,nqdesc(iq)1024 iq2= iqfils(ifils,iq)1031 if (tr%ndesc > 0) then 1032 do ichld=1,tr%ndesc 1033 iq2=tr%idesc(ichld) 1025 1034 DO l=1,llm 1026 1035 DO ij=1,ip1jmp1 … … 1028 1037 enddo 1029 1038 enddo 1030 enddo !do i fils=1,nqdesc(iq)1031 endif !if ( nqfils(iq).gt.0) then1039 enddo !do ichld=1,tr%ndesc 1040 endif !if (tr%ndesc > 0) 1032 1041 !write(*,*) 'vlsplt 1032' 1033 1042
Note: See TracChangeset
for help on using the changeset viewer.