Changeset 1494 for LMDZ5/trunk/libf/phylmd/thermcell_main.F90

Timestamp:

Mar 9, 2011, 11:05:02 AM (13 years ago)

Author:

Laurent Fairhead

Message:

Optimization of routines from the new physics

---

Optimisation de routines de la nouvelle physique

File:

• LMDZ5/trunk/libf/phylmd/thermcell_main.F90 (modified) (12 diffs)

LMDZ5/trunk/libf/phylmd/thermcell_main.F90

@@ -80 +80 @@
 !$OMP THREADPRIVATE(lev_out)
 
-      INTEGER ig,k,l,ll
+      INTEGER ig,k,l,ll,ierr
       real zsortie1d(klon)
       INTEGER lmax(klon),lmin(klon),lalim(klon)
@@ -233 +233 @@
 !     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
      do ig=1,klon
-      if (prt_level.ge.20) then
-       print*,'th_main ig f0',ig,f0(ig)
-      endif
          f0(ig)=max(f0(ig),1.e-2)
          zmax0(ig)=max(zmax0(ig),40.)
@@ -241 +238 @@
      enddo
 
+      if (prt_level.ge.20) then
+       do ig=1,ngrid
+          print*,'th_main ig f0',ig,f0(ig)
+       enddo
+      endif
 !-----------------------------------------------------------------------
 ! Calcul de T,q,ql a partir de Tl et qT dans l environnement
@@ -290 +292 @@
 !-----------------------------------------------------------------------
 
-      do l=1,nlay
-         rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l))
-      enddo
-
-!IM
+     rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
+
      if (prt_level.ge.10)write(lunout,*)                                &
     &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
@@ -619 +618 @@
       enddo
 !IM
+      ierr=0
       do ig=1,ngrid
         if (pcon(ig).le.pplay(ig,nlay)) then 
            zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
+           ierr=1
+        endif
+      enddo
+      if (ierr==1) then
            abort_message = 'thermcellV0_main: les thermiques vont trop haut '
            CALL abort_gcm (modname,abort_message,1)
-        endif
-      enddo
+      endif
+
       if (prt_level.ge.1) print*,'14b OK convect8'
       do k=nlay,1,-1
@@ -655 +659 @@
             zf2=zf/(1.-zf)
 !
-      if (prt_level.ge.10) print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2
-!
-      if (prt_level.ge.10) print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
             thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2
             if(zw2(ig,l).gt.1.e-10) then
@@ -664 +665 @@
              wth2(ig,l)=0.
             endif
-!           print*,'wth2=',wth2(ig,l)
             wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
      &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
-      if (prt_level.ge.10) print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
             q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
 !test: on calcul q2/po=ratqsc
@@ -682 +681 @@
       enddo
 !
+      if (prt_level.ge.10) then
+         ig=igout
+         do l=1,nlay
+            print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
+            print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
+         enddo
+      endif
+
 !      print*,'avant calcul ale et alp' 
 !calcul de ALE et ALP pour la convection
@@ -705 +712 @@
 !initialisations
 !      print*,'ponderation'
-      do ig=1,ngrid
-           fm_tot(ig)=0.
-      enddo
-       do ig=1,ngrid
-        do k=1,klev
-           wght_th(ig,k)=1.
-        enddo
-       enddo
-       do ig=1,ngrid
-!         lalim_conv(ig)=lmix_bis(ig)
-!la hauteur de la couche alim_conv = hauteur couche alim_therm
-         lalim_conv(ig)=lalim(ig)
-!         zentr(ig)=zlev(ig,lalim(ig))
-      enddo
-      do ig=1,ngrid
-        do k=1,lalim_conv(ig)
-           fm_tot(ig)=fm_tot(ig)+fm(ig,k)
-        enddo
-      enddo
-      do ig=1,ngrid
-        do k=1,lalim_conv(ig)
-           if (fm_tot(ig).gt.1.e-10) then
-!           wght_th(ig,k)=fm(ig,k)/fm_tot(ig)
-           endif
-!on pondere chaque couche par a*
-             if (alim_star(ig,k).gt.1.e-10) then
-             wght_th(ig,k)=alim_star(ig,k)
-             else
-             wght_th(ig,k)=1.
-             endif
-        enddo
-      enddo
+
+      fm_tot(:)=0.
+      wght_th(:,:)=1.
+      lalim_conv(:)=lalim(:)
+
+      do k=1,klev
+         do ig=1,ngrid
+            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
+         enddo
+      enddo
+
+! assez bizarre car, si on est dans la couche d'alim et que alim_star et
+! plus petit que 1.e-10, on prend wght_th=1.
+      do k=1,klev
+         do ig=1,ngrid
+            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then
+               wght_th(ig,k)=alim_star(ig,k)
+            endif
+         enddo
+      enddo
+
 !      print*,'apres wght_th'
 !test pour prolonger la convection
@@ -748 +744 @@
       enddo
 
+
 !calcul du ratqscdiff
       if (prt_level.ge.1) print*,'14e OK convect8'
@@ -753 +750 @@
       vardiff=0.
       ratqsdiff(:,:)=0.
-      do ig=1,ngrid
-         do l=1,lalim(ig)
+
+      do l=1,klev
+         do ig=1,ngrid
+            if (l<=lalim(ig)) then
             var=var+alim_star(ig,l)*zqta(ig,l)*1000.
-         enddo
-      enddo
+            endif
+         enddo
+      enddo
+
       if (prt_level.ge.1) print*,'14f OK convect8'
-      do ig=1,ngrid
-          do l=1,lalim(ig)
-          zf=fraca(ig,l)
-          zf2=zf/(1.-zf)
-          vardiff=vardiff+alim_star(ig,l)  &
-     &           *(zqta(ig,l)*1000.-var)**2
-!         ratqsdiff=ratqsdiff+alim_star(ig,l)*
-!     s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-          enddo
-      enddo
+
+      do l=1,klev
+         do ig=1,ngrid
+            if (l<=lalim(ig)) then
+               zf=fraca(ig,l)
+               zf2=zf/(1.-zf)
+               vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2
+            endif
+         enddo
+      enddo
+
       if (prt_level.ge.1) print*,'14g OK convect8'
       do l=1,nlay
@@ -779 +781 @@
 !
 !ecriture des fichiers sortie
-!     print*,'15 OK convect8'
+!     print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc'
 
 #ifdef wrgrads_thermcell