Changeset 1020 for trunk/LMDZ.MARS/libf/aeronomars

Timestamp:

Aug 27, 2013, 9:22:40 AM (11 years ago)

Author:

emillour

Message:

Mars GCM:
(Minor) optimizations: avoid seding non-contiguous arrays to routines (to avoid implicit copies of these arrays before and after being sent to the routine).
EM

File:

• trunk/LMDZ.MARS/libf/aeronomars/moldiff_red.F90 (modified) (10 diffs)

trunk/LMDZ.MARS/libf/aeronomars/moldiff_red.F90

@@ -36 +36 @@
 
       integer,dimension(nqmx) :: indic_diff
-      integer ig,nz,l,k,n,nn,p,ij0
+      integer ig,iq,nz,l,k,n,nn,p,ij0
       integer istep,il,gcn,ntime,nlraf
       real*8 masse
@@ -47 +47 @@
       real*8 tt(nlayermx),tnew(nlayermx),tint(nlayermx)
       real*8 zz(nlayermx)
-      real*8,dimension(:,:),allocatable :: qq,qnew,qint,FacMass
-      real*8,dimension(:,:),allocatable :: rhoK,rhokinit
+      real*8,dimension(:,:),allocatable,save :: qq,qnew,qint,FacMass
+      real*8,dimension(:,:),allocatable,save :: rhoK,rhokinit
       real*8 rhoT(nlayermx)
       real*8 dmmeandz(nlayermx)
@@ -60 +60 @@
       real*8,dimension(:),allocatable :: Atri,Btri,Ctri,Dtri,Xtri,Tad,Dad,Zad,rhoad
       real*8,dimension(:),allocatable :: alpha,beta,gama,delta,eps
-      real*8,dimension(:),allocatable ::  wi,Wad,Uthermal,Lambdaexo,Hspecie
-      real*8,dimension(:),allocatable :: Mtot1,Mtot2,Mraf1,Mraf2
+      real*8,dimension(:),allocatable,save ::  wi,Wad,Uthermal,Lambdaexo,Hspecie
+      real*8,dimension(:),allocatable,save :: Mtot1,Mtot2,Mraf1,Mraf2
       character(len=20),dimension(14) :: ListeDiff
 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
@@ -140 +140 @@
         enddo
         if (indic_diff(nn) .eq. 1) then
-        print*,'specie', noms(nn), 'diffused in moldiff_red'
+        print*,'specie ', noms(nn), 'diffused in moldiff_red'
         ncompdiff=ncompdiff+1
         endif
@@ -172 +172 @@
         call moldiffcoeff_red(dij,indic_diff,gcmind,ncompdiff)
         print*,'MOLDIFF  EXO'
+
+! allocatation des tableaux dependants du nombre d especes diffusees
+        allocate(qq(nlayermx,ncompdiff))
+        allocate(qnew(nlayermx,ncompdiff))
+        allocate(qint(nlayermx,ncompdiff))
+        allocate(FacMass(nlayermx,ncompdiff))
+        allocate(rhok(nlayermx,ncompdiff))
+        allocate(rhokinit(nlayermx,ncompdiff))
+
+        allocate(wi(ncompdiff))
+        allocate(wad(ncompdiff))
+        allocate(uthermal(ncompdiff))
+        allocate(lambdaexo(ncompdiff))
+        allocate(Hspecie(ncompdiff))
+        allocate(Mtot1(ncompdiff))
+        allocate(Mtot2(ncompdiff))
+        allocate(Mraf1(ncompdiff))
+        allocate(Mraf2(ncompdiff))
 
         firstcall= .false.
@@ -191 +209 @@
         invsgmu=1d0/g/masseU
         
-! allocatation des tableaux dependants du nombre d especes diffusees
-        allocate(qq(nlayermx,ncompdiff))
-        allocate(qnew(nlayermx,ncompdiff))
-        allocate(qint(nlayermx,ncompdiff))
-        allocate(FacMass(nlayermx,ncompdiff))
-        allocate(rhok(nlayermx,ncompdiff))
-        allocate(rhokinit(nlayermx,ncompdiff))
-
-        allocate(wi(ncompdiff))
-        allocate(wad(ncompdiff))
-        allocate(uthermal(ncompdiff))
-        allocate(lambdaexo(ncompdiff))
-        allocate(Hspecie(ncompdiff))
-        allocate(Mtot1(ncompdiff))
-        allocate(Mtot2(ncompdiff))
-        allocate(Mraf1(ncompdiff))
-        allocate(Mraf2(ncompdiff))
-
 !       print*,'moldiff',i_h2,i_h,ncompdiff
       do ig=1,ngridmx
@@ -215 +215 @@
 ! Update the temperature
 
-        CALL TMNEW(pt(ig,:),pdt(ig,:),pdtconduc(ig,:),pdteuv(ig,:)      & 
-     &  ,tt,ptimestep,nlayermx,ig)
+!       CALL TMNEW(pt(ig,:),pdt(ig,:),pdtconduc(ig,:),pdteuv(ig,:)      & 
+!     &  ,tt,ptimestep,nlayermx,ig)
+        do l=1,nlayermx
+          tt(l)=pt(ig,l)*1D0+(pdt(ig,l)*dble(ptimestep)+                &
+                              pdtconduc(ig,l)*dble(ptimestep)+          &
+                              pdteuv(ig,l)*dble(ptimestep))
+          ! to cach Nans...
+          if (tt(l).ne.tt(l)) then
+            print*,'Err TMNEW',ig,l,tt(l),pt(ig,l),                     &
+              pdt(ig,l),pdtconduc(ig,l),pdteuv(ig,l),dble(ptimestep)
+          endif
+        enddo ! of do l=1,nlayermx
 
 ! Update the mass mixing ratios modified by other processes
 
-        CALL QMNEW(pq(ig,:,:),pdq(ig,:,:),qq,ptimestep,nlayermx,        &
-     &  ncompdiff,gcmind,ig)
+!       CALL QMNEW(pq(ig,:,:),pdq(ig,:,:),qq,ptimestep,nlayermx,        &
+!     &  ncompdiff,gcmind,ig)
+        do iq=1,ncompdiff
+         do l=1,nlayermx
+          qq(l,iq)=pq(ig,l,gcmind(iq))*1D0+(                            &
+                           pdq(ig,l,gcmind(iq))*dble(ptimestep))
+          qq(l,iq)=max(qq(l,iq),1d-30)
+         enddo ! of do l=1,nlayermx
+        enddo ! of do iq=1,ncompdiff
 
 ! Compute the Pressure scale height
@@ -282 +299 @@
 
 !       if (nlraf .ge. 200) print*,ig,nlraf,Zmin,Zmax
-
-! allocation for arrays
-
-        allocate(Praf(nlraf),Traf(nlraf),Rraf(nlraf),Mraf(nlraf))
-        allocate(Nraf(nlraf),Draf(nlraf),Hraf(nlraf),Wraf(nlraf))
-        allocate(Zraf(nlraf),Tdiffraf(nlraf))
-        allocate(Prafold(nlraf),Mrafold(nlraf))
-        allocate(Qraf(nlraf,ncompdiff),Rrafk(nlraf,ncompdiff),Nrafk(nlraf,ncompdiff))
-        allocate(Rrafkold(nlraf,ncompdiff))
-        allocate(Drafmol(nlraf,ncompdiff),Hrafmol(nlraf,ncompdiff))
-        allocate(Wrafmol(nlraf,ncompdiff),Tdiffrafmol(nlraf,ncompdiff))
-        allocate(Atri(nlraf),Btri(nlraf),Ctri(nlraf),Dtri(nlraf),Xtri(nlraf))
-        allocate(Tad(nlraf),Dad(nlraf),Zad(nlraf),rhoad(nlraf))
-        allocate(alpha(nlraf),beta(nlraf),gama(nlraf),delta(nlraf),eps(nlraf))
+        
+         ! allocate arrays:
+         allocate(Praf(nlraf),Traf(nlraf),Rraf(nlraf),Mraf(nlraf))
+         allocate(Nraf(nlraf),Draf(nlraf),Hraf(nlraf),Wraf(nlraf))
+         allocate(Zraf(nlraf),Tdiffraf(nlraf))
+         allocate(Prafold(nlraf),Mrafold(nlraf))
+         allocate(Qraf(nlraf,ncompdiff),Rrafk(nlraf,ncompdiff),Nrafk(nlraf,ncompdiff))
+         allocate(Rrafkold(nlraf,ncompdiff))
+         allocate(Drafmol(nlraf,ncompdiff),Hrafmol(nlraf,ncompdiff))
+         allocate(Wrafmol(nlraf,ncompdiff),Tdiffrafmol(nlraf,ncompdiff))
+         allocate(Atri(nlraf),Btri(nlraf),Ctri(nlraf),Dtri(nlraf),Xtri(nlraf))
+         allocate(Tad(nlraf),Dad(nlraf),Zad(nlraf),rhoad(nlraf))
+         allocate(alpha(nlraf),beta(nlraf),gama(nlraf),delta(nlraf),eps(nlraf))
 
 ! before beginning, I use a better vertical resolution above il0, 
@@ -610 +626 @@
        enddo  ! ig loop         
 
-        deallocate(qq,qnew,qint)
-        deallocate(FacMass)
-        deallocate(rhok,rhokinit)
-        deallocate(wi,wad,uthermal,lambdaexo)
-        deallocate(Hspecie)
-        deallocate(Mtot1,Mtot2,Mraf1,Mraf2)
 
       return
@@ -1162 +1172 @@
         H(nl)=-1D0/H(nl)
 
-        do l=1,nl
-        if (abs(H(l)) .lt. 100.) then
+!       do l=1,nl
+!       if (abs(H(l)) .lt. 100.) then
 !       print*,'H',l,H(l),Nk(l,nn),nn
-        endif
-        enddo
+!       endif
+!       enddo
 
         END