Changeset 1212 for LMDZ4/branches/LMDZ4-dev/libf/phylmd

Timestamp:

Jul 21, 2009, 9:59:02 AM (15 years ago)

Author:

jghattas

Message:

• Correction dans la recherche du traceur Berelium
• Correction des messages d'erreurs
• Enleve allocate pas necessaire
• Ajoute argument d'entree pour traclmdz bientot necessaire (pour parametrization Cariolle)

Location:

LMDZ4/branches/LMDZ4-dev/libf/phylmd

Files:

• phytrac.F90 (modified) (1 diff)
• traclmdz_mod.F90 (modified) (10 diffs)

LMDZ4/branches/LMDZ4-dev/libf/phylmd/phytrac.F90

@@ -235 +235 @@
      
      CALL traclmdz(&
-          pdtphys,  t_seri,                         &
+          nstep,    pdtphys,      t_seri,           &
           paprs,    pplay,        cdragh,  coefh,   &
           yu1,      yv1,          ftsol,   pctsrf,  &

LMDZ4/branches/LMDZ4-dev/libf/phylmd/traclmdz_mod.F90

@@ -57 +57 @@
     ! Allocate restart variables trs
     ALLOCATE( trs(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('traclmdz_start', 'pb in allocation 1',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_from_restart', 'pb in allocation 1',1)
     
     ! Initialize trs with values read from restart file 
@@ -90 +90 @@
 
     ALLOCATE( scavtr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 9',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 9',1)
     scavtr(:)=1.
     
     ALLOCATE( radio(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 11',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 11',1)
     radio(:) = .false.    ! Par defaut pas decroissance radioactive
     
     ALLOCATE( masktr(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 2',1)
     
     ALLOCATE( fshtr(klon,nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 3',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 3',1)
     
     ALLOCATE( hsoltr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 4',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 4',1)
     
     ALLOCATE( tautr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 5',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 5',1)
     tautr(:)  = 0.
     
     ALLOCATE( vdeptr(nbtr), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 6',1)
+    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 6',1)
     vdeptr(:) = 0.
 
@@ -121 +121 @@
 ! Recherche des traceurs connus : Be7, CO2,...
 ! --------------------------------------------
+    id_be=0
     DO it=1,nbtr
        iiq=niadv(it+2)
-       !
-       ! Recherche du Beryllium 7
-       !
        IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR.  &
             tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN  
+          ! Recherche du Beryllium 7
           id_be=it
           ALLOCATE( srcbe(klon,klev) )
@@ -134 +133 @@
           CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
           WRITE(*,*) 'Initialisation srcBe: OK'
-       ELSE
-          id_be=0
-       END IF
-       
-       ! Placer ici la recherche de nouveaux traceurs
-       ! ...
+       END IF    
     END DO
 !
@@ -159 +153 @@
 
   SUBROUTINE traclmdz(                           &
-       pdtphys,  t_seri,                         &
+       nstep,    pdtphys,      t_seri,           &
        paprs,    pplay,        cdragh,  coefh,   &
        yu1,      yv1,          ftsol,   pctsrf,  &
@@ -180 +174 @@
 !
 !Configuration grille,temps:
+    INTEGER,INTENT(IN) :: nstep      ! nombre d'appels de la physiq
     REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)  
     REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point 
@@ -218 +213 @@
 
     INTEGER :: i, k, it
-  
 
     REAL,DIMENSION(klon)           :: d_trs    ! Td dans le reservoir
@@ -250 +244 @@
 
     IF (couchelimite) THEN             
-       DO it=1, nbtr
-          IF ( it == id_be ) THEN
-             DO i=1, klon
-                zrho = pplay(i,1)/t_seri(i,1)/RD
-                source(i,it) = - vdeptr(it)*tr_seri(i,1,it)*zrho
-             END DO
-          ELSE
-             source(:,it) = 0.0  
-          END IF
-       END DO
+       source(:,:) = 0.0
+
+       IF (id_be /=0) THEN
+          DO i=1, klon
+             zrho = pplay(i,1)/t_seri(i,1)/RD
+             source(i,id_be) = - vdeptr(id_be)*tr_seri(i,1,id_be)*zrho
+          END DO
+       END IF
+
     END IF
     
@@ -307 +300 @@
        END IF
     END DO
-    
 
   END SUBROUTINE traclmdz
@@ -322 +314 @@
     REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
     INTEGER :: ierr
-    !AJ-beg - 
-    ALLOCATE( trs(klon,nbtr), stat=ierr )
-    IF (ierr == 0) THEN
-    ! no previous allocate [case create_etat0_limit.e]
-         trs_out(:,:) = 0.0
+
+    IF ( ALLOCATED(trs) ) THEN
+       trs_out(:,:) = trs(:,:)
     ELSE
-    ! already allocate by traclmdz_from_restart() [case gcm.e]
-         trs_out(:,:) = trs(:,:)
+       ! No previous allocate of trs. This is the case for create_etat0_limit.
+       trs_out(:,:) = 0.0
     END IF
-    !cAJ-end -
+    
   END SUBROUTINE traclmdz_to_restart