Changeset 1454 for LMDZ5/trunk/libf/dyn3dpar/infotrac.F90

Timestamp:

Nov 18, 2010, 1:01:24 PM (14 years ago)

Author:

Laurent Fairhead

Message:

Merge of LMDZ5V1.0-dev branch r1453 into LMDZ5 trunk r1434

---

Fusion entre la version r1453 de la branche de développement LMDZ5V1.0-dev
et le tronc LMDZ5 (r1434)

Location:

LMDZ5/trunk

Files:

• . (modified) (1 prop)
• libf/dyn3dpar/infotrac.F90 (modified) (14 diffs)

LMDZ5/trunk/libf/dyn3dpar/infotrac.F90

@@ -61 +61 @@
     CHARACTER(len=1), DIMENSION(3)  :: txts
     CHARACTER(len=2), DIMENSION(9)  :: txtp
-    CHARACTER(len=13)               :: str1,str2
+    CHARACTER(len=23)               :: str1,str2
   
     INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
     INTEGER :: iq, new_iq, iiq, jq, ierr
-    INTEGER, EXTERNAL :: lnblnk
- 
+
+    character(len=*),parameter :: modname="infotrac_init"
 !-----------------------------------------------------------------------
 ! Initialization :
@@ -100 +100 @@
        OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
        IF(ierr.EQ.0) THEN
-          WRITE(lunout,*) 'Open traceur.def : ok'
+          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
           READ(90,*) nqtrue
        ELSE 
-          WRITE(lunout,*) 'Problem in opening traceur.def'
-          WRITE(lunout,*) 'ATTENTION using defaut values'
-          nqtrue=4 ! Defaut value
-       END IF
-       ! Attention! Only for planet_type=='earth'
-       nbtr=nqtrue-2
+          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
+          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
+          if (planet_type=='earth') then
+            nqtrue=4 ! Default value for Earth
+          else
+            nqtrue=1 ! Default value for other planets
+          endif
+       END IF
+       if ( planet_type=='earth') then
+         ! For Earth, water vapour & liquid tracers are not in the physics
+         nbtr=nqtrue-2
+       else
+         ! Other planets (for now); we have the same number of tracers
+         ! in the dynamics than in the physics
+         nbtr=nqtrue
+       endif
     ELSE
        ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F 
@@ -114 +124 @@
     END IF
 
-    IF (nqtrue < 2) THEN
-       WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
+    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
+       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
        CALL abort_gcm('infotrac_init','Not enough tracers',1)
     END IF
@@ -156 +166 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
-       ELSE ! Without tracer.def
+       ELSE ! Without tracer.def, set default values 
+         if (planet_type=="earth") then
+          ! for Earth, default is to have 4 tracers
           hadv(1) = 14
           vadv(1) = 14
@@ -172 +184 @@
           vadv(4) = 10
           tnom_0(4) = 'PB'
+         else ! default for other planets
+          hadv(1) = 10
+          vadv(1) = 10
+          tnom_0(1) = 'dummy'
+         endif ! of if (planet_type=="earth")
        END IF
        
-       WRITE(lunout,*) 'Valeur de traceur.def :'
-       WRITE(lunout,*) 'nombre de traceurs ',nqtrue
+       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
+       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
        DO iq=1,nqtrue
           WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
@@ -217 +234 @@
           new_iq=new_iq+10 ! 9 tracers added
        ELSE
-          WRITE(lunout,*) 'This choice of advection schema is not available'
+          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
        END IF
@@ -227 +244 @@
        nqtot = new_iq
 
-       WRITE(lunout,*) 'The choice of advection schema for one or more tracers'
+       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
        WRITE(lunout,*) 'makes it necessary to add tracers'
-       WRITE(lunout,*) nqtrue,' is the number of true tracers'
-       WRITE(lunout,*) nqtot, ' is the total number of tracers needed'
+       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
+       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
 
     ELSE
@@ -258 +275 @@
           iadv(new_iq)=11
        ELSE
-          WRITE(lunout,*)'This choice of advection schema is not available'
+          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
+
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
        END IF
@@ -265 +283 @@
        tname(new_iq)= tnom_0(iq)
        IF (iadv(new_iq)==0) THEN
-          ttext(new_iq)=str1(1:lnblnk(str1))
+          ttext(new_iq)=trim(str1)
        ELSE
-          ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq))
+          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
        END IF
 
@@ -276 +294 @@
              new_iq=new_iq+1
              iadv(new_iq)=-20
-             ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq)
-             tname(new_iq)=str1(1:lnblnk(str1))//txts(jq)
+             ttext(new_iq)=trim(str2)//txts(jq)
+             tname(new_iq)=trim(str1)//txts(jq)
           END DO
        ELSE IF (iadv(new_iq)==30) THEN
@@ -283 +301 @@
              new_iq=new_iq+1
              iadv(new_iq)=-30
-             ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq)
-             tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq)
+             ttext(new_iq)=trim(str2)//txtp(jq)
+             tname(new_iq)=trim(str1)//txtp(jq)
           END DO
        END IF
@@ -303 +321 @@
 
 
-    WRITE(lunout,*) 'Information stored in infotrac :'
-    WRITE(lunout,*) 'iadv  niadv tname  ttext :'
+    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
+    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
     DO iq=1,nqtot
-       WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq)
+       WRITE(lunout,*) iadv(iq),niadv(iq),&
+       ' ',trim(tname(iq)),' ',trim(ttext(iq))
     END DO
 
@@ -315 +334 @@
     DO iq=1,nqtot
        IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
-          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
           CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
        ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
-          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
           CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
        END IF
@@ -329 +348 @@
     DEALLOCATE(tracnam)
 
-999 FORMAT (i2,1x,i2,1x,a15)
-
   END SUBROUTINE infotrac_init