Changeset 1114 for LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/leapfrog_p.F

Timestamp:

Mar 3, 2009, 5:40:26 PM (15 years ago)

Author:

jghattas

Message:

Creation du module infotrac:

• contient les variables de advtrac.h
• contient la subroutine iniadvtrac renommer en infotrac_init
• le nombre des traceurs est lu dans tracer.def en dynamique (ou par default ou recu par INCA)
• ce module est utilise dans la dynamique et la physique
• contient aussi la variable nbtr qui avant etait stockee dans dimphy

Le fichier advtrac.h n'existe plus.
La compilation ne prend plus en compte le nombre de traceur.

/JG

File:

• LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/leapfrog_p.F (modified) (30 diffs)

LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/leapfrog_p.F

@@ -9 +9 @@
 #define CPP_IOIPSL
 
-      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
+      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
      &                    time_0)
 
@@ -21 +21 @@
        USE vampir
        USE timer_filtre, ONLY : print_filtre_timer
+       USE infotrac
 
       IMPLICIT NONE
@@ -69 +70 @@
 #include "com_io_dyn.h"
 #include "iniprint.h"
-
-c#include "tracstoke.h"
-
 #include "academic.h"
-!#include "clesphys.h"
-#include "advtrac.h"
       
-      integer nq
-
       INTEGER         longcles
       PARAMETER     ( longcles = 20 )
@@ -88 +82 @@
       REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
       REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle 
-      REAL :: q(ip1jmp1,llm,nqmx)               ! champs advectes
+      REAL :: q(ip1jmp1,llm,nqtot)              ! champs advectes
       REAL :: ps(ip1jmp1)                       ! pression  au sol
       REAL,SAVE :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
@@ -109 +103 @@
 c   tendances dynamiques
       REAL,SAVE :: dv(ip1jm,llm),du(ip1jmp1,llm)
-      REAL,SAVE :: dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
+      REAL,SAVE :: dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
 
 c   tendances de la dissipation
@@ -118 +113 @@
       REAL,SAVE :: dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
       REAL,SAVE :: dtetafi(ip1jmp1,llm)
-      REAL,SAVE :: dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
+      REAL,SAVE :: dpfi(ip1jmp1)
+      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
 
 c   variables pour le fichier histoire
@@ -186 +182 @@
       type(Request) :: Request_physic
       REAL,SAVE :: dvfi_tmp(iip1,llm),dufi_tmp(iip1,llm)
-      REAL,SAVE :: dtetafi_tmp(iip1,llm),dqfi_tmp(iip1,llm,nqmx)
+      REAL,SAVE :: dtetafi_tmp(iip1,llm)
+      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi_tmp
       REAL,SAVE :: dpfi_tmp(iip1)
 
@@ -195 +192 @@
       INTEGER :: var_time
       LOGICAL :: ok_start_timer=.FALSE.
+      LOGICAL, SAVE :: firstcall=.TRUE.
 
 c$OMP MASTER
@@ -208 +206 @@
       itaufin   = nday*day_step
       itaufinp1 = itaufin +1
-
+      modname="leapfrog_p"
 
       itau = 0
@@ -217 +215 @@
           iday = iday+1
          ENDIF
+
+c Allocate variables depending on dynamic variable nqtot
+c$OMP MASTER
+         IF (firstcall) THEN
+            firstcall=.FALSE.
+            ALLOCATE(dq(ip1jmp1,llm,nqtot))
+            ALLOCATE(dqfi(ip1jmp1,llm,nqtot))
+            ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
+         END IF
+c$OMP END MASTER      
+c$OMP BARRIER
 
 c-----------------------------------------------------------------------
@@ -455 +464 @@
      &                                jj_Nb_caldyn,0,0,TestRequest)
  
-        do j=1,nqmx
+        do j=1,nqtot
          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
      &                                jj_nb_caldyn,0,0,TestRequest)
@@ -490 +499 @@
        call Register_Hallo(p,ip1jmp1,llmp1,1,1,1,1,TestRequest)
        
-c       do j=1,nqmx
+c       do j=1,nqtot
 c         call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
 c     *                       TestRequest)
@@ -516 +525 @@
         call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
         call WriteField_p('phis',reshape(phis,(/iip1,jmp1/)))
-        do j=1,nqmx
+        do j=1,nqtot
           call WriteField_p('q'//trim(int2str(j)),
      .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
@@ -608 +617 @@
 c$OMP BARRIER
 !       CALL FTRACE_REGION_BEGIN("integrd")
+
        CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
      $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
@@ -625 +635 @@
 c
 c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
-c      do j=1,nqmx
+c      do j=1,nqtot
 c        call WriteField_p('q'//trim(int2str(j)),
 c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
@@ -669 +679 @@
 
 c$OMP BARRIER
-
          CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
 c$OMP BARRIER
@@ -725 +734 @@
         
 c        call SetDistrib(jj_nb_vanleer)
-        do j=1,nqmx
+        do j=1,nqtot
  
           call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
@@ -756 +765 @@
 cc$OMP BARRIER
 !        CALL FTRACE_REGION_BEGIN("calfis")
-        CALL calfis_p( nq, lafin ,rdayvrai,time  ,
+        CALL calfis_p(lafin ,rdayvrai,time  ,
      $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
      $               du,dv,dteta,dq,
@@ -799 +808 @@
      *                      1,0,0,1,Request_physic)
 
-        do j=1,nqmx
+        do j=1,nqtot
           call Register_Hallo(dqfi(1,1,j),ip1jmp1,llm,
      *                        1,0,0,1,Request_physic)
@@ -842 +851 @@
 cc$OMP END MASTER
 c      
-c      do j=1,nqmx
+c      do j=1,nqtot
 c        call WriteField_p('dqfi'//trim(int2str(j)),
 c     .                reshape(dqfi(:,:,j),(/iip1,jmp1,llm/)))
@@ -853 +862 @@
          ENDIF
        
-          CALL addfi_p( nqmx, dtphys, leapf, forward   ,
+          CALL addfi_p( dtphys, leapf, forward   ,
      $                  ucov, vcov, teta , q   ,ps ,
      $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
@@ -889 +898 @@
      *                               jj_Nb_caldyn,Request_physic)
 
-        do j=1,nqmx
+        do j=1,nqtot
         
           call Register_SwapField(q(1,1,j),q(1,1,j),ip1jmp1,llm,
@@ -954 +963 @@
         CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
 c$OMP BARRIER
-
-
         CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
 c$OMP BARRIER
@@ -1291 +1298 @@
 c$OMP BARRIER
 c$OMP MASTER
-              CALL writedynav_p(histaveid, nqmx, itau,vcov ,
+              CALL writedynav_p(histaveid, itau,vcov ,
      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
 c$OMP END MASTER
@@ -1339 +1346 @@
 #ifdef CPP_IOIPSL
  
-        CALL writehist_p(histid,histvid, nqmx,itau,vcov, 
+        CALL writehist_p(histid,histvid, itau,vcov, 
      s                       ucov,teta,phi,q,masse,ps,phis)
 
@@ -1354 +1361 @@
 
        CALL dynredem1_p("restart.nc",0.0,
-     ,                     vcov,ucov,teta,q,nqmx,masse,ps)
+     ,                     vcov,ucov,teta,q,masse,ps)
 c#endif
 
@@ -1437 +1444 @@
 c$OMP BARRIER
 c$OMP MASTER
-              CALL writedynav_p(histaveid, nqmx, itau,vcov ,
+              CALL writedynav_p(histaveid, itau,vcov ,
      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
                call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
@@ -1480 +1487 @@
 #ifdef CPP_IOIPSL
 
-       CALL writehist_p( histid, histvid, nqmx, itau,vcov , 
+       CALL writehist_p( histid, histvid, itau,vcov , 
      ,                           ucov,teta,phi,q,masse,ps,phis)
 c#else
@@ -1487 +1494 @@
 c      call Gather_Field(teta,ip1jmp1,llm,0)
 c      call Gather_Field(ps,ip1jmp1,1,0)
-c      do iq=1,nqmx
+c      do iq=1,nqtot
 c        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
 c      enddo
@@ -1502 +1509 @@
 c$OMP MASTER
                    CALL dynredem1_p("restart.nc",0.0,
-     .                               vcov,ucov,teta,q,nqmx,masse,ps)
+     .                               vcov,ucov,teta,q,masse,ps)
 c$OMP END MASTER
                  ENDIF