Changeset 72

Timestamp:

08/02/12 20:44:58 (12 years ago)

Author:

dubos

Message:

Improved etat0_dcmip1.f90

File:

• codes/icosagcm/trunk/src/etat0_dcmip1.f90 (modified) (8 diffs)

codes/icosagcm/trunk/src/etat0_dcmip1.f90

@@ -38 +38 @@
     REAL(rstd),POINTER :: u(:,:)
     REAL(rstd),POINTER :: q(:,:,:)
+    CHARACTER(len=255) :: dcmip1_adv_shape
     INTEGER :: ind
     
     R0=radius*0.5
     rt=radius*0.5
+    dcmip1_adv_shape='cos_bell'
+    CALL getin('dcmip1_shape',dcmip1_adv_shape)
     
     DO ind=1,ndomain
@@ -51 +54 @@
       u=f_u(ind)
       q=f_q(ind)
-      CALL compute_etat0_ncar(ps, phis, theta_rhodz, u, q(:,:,1))
+
+
+      SELECT CASE(TRIM(dcmip1_adv_shape))
+      CASE('const')
+         CALL compute_etat0_ncar(1,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('cos_bell')
+         CALL compute_etat0_ncar(2,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('slotted_cyl')
+         CALL compute_etat0_ncar(3,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('dbl_cos_bell_q1')
+         CALL compute_etat0_ncar(4,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('dbl_cos_bell_q2')
+         CALL compute_etat0_ncar(5,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('complement')
+         CALL compute_etat0_ncar(6,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('hadley')  ! hadley like meridional circulation 
+         CALL compute_etat0_ncar(7,ps, phis, theta_rhodz, u, q(:,:,1))
+      CASE('dcmip11')
+         IF(nqtot==5) THEN
+            CALL compute_etat0_ncar(4,ps, phis, theta_rhodz, u, q(:,:,1))
+            CALL compute_etat0_ncar(5,ps, phis, theta_rhodz, u, q(:,:,2))
+            CALL compute_etat0_ncar(3,ps, phis, theta_rhodz, u, q(:,:,3))
+            CALL compute_etat0_ncar(6,ps, phis, theta_rhodz, u, q(:,:,4))
+            CALL compute_etat0_ncar(1,ps, phis, theta_rhodz, u, q(:,:,5))
+         ELSE
+            PRINT *,'Error : etat0_dcmip=dcmip11 and nqtot = ',nqtot,' .'
+            PRINT *,'nqtot must be equal to 5 when etat0_dcmip=dcmip11'
+            STOP
+         END IF
+      CASE DEFAULT
+         PRINT *, 'Bad selector for variable dcmip1_adv_shape : <', TRIM(dcmip1_adv_shape),   &
+              '> options are <const>, <slotted_cyl>, <cos_bell>, <dbl_cos_bell_q1>', &
+              '<dbl_cos_bell_q2>, <complement>, <hadley>'
+         STOP
+      END SELECT
+
     ENDDO
 
   END SUBROUTINE etat0
   
-  SUBROUTINE compute_etat0_ncar(ps, phis, theta_rhodz, u, q)
+  SUBROUTINE compute_etat0_ncar(icase, ps, phis, theta_rhodz, u, q)
   USE icosa
   USE disvert_mod
@@ -64 +102 @@
   USE theta2theta_rhodz_mod
   IMPLICIT NONE  
+  INTEGER, INTENT(in) :: icase
   REAL(rstd),INTENT(OUT) :: ps(iim*jjm)
   REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
@@ -69 +108 @@
   REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm)
   REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm)  
-
 
   REAL(rstd) :: qxt1(iim*jjm,llm)
@@ -78 +116 @@
   REAL(rstd) :: X2(3),X1(3)
   INTEGER :: i,j,n,l
-  CHARACTER(len=255) :: ncar_adv_shape
 
   u = 0.0 ; phis = 0 ; theta_rhodz = 0 ; ps = ncar_p0
@@ -91 +128 @@
   END DO
   
-  ncar_adv_shape='cos_bell'
-  CALL getin('ncar_adv_shape',ncar_adv_shape)
-  
-  SELECT CASE(TRIM(ncar_adv_shape))
+  SELECT CASE(icase)
+  CASE(1)
+     q=1
+  CASE(2)
      !--------------------------------------------- SINGLE COSINE BELL
-  CASE('const')
-     q=1
-  CASE('cos_bell')
-     CALL cosine_bell_1(q) 
-     
-  CASE('slotted_cyl')
+     CALL cosine_bell_1(q)      
+  CASE(3)
      CALL slotted_cylinders(q)  
-     
-  CASE('dbl_cos_bell_q1')
-     CALL cosine_bell_2(q) 
-     
-  CASE('dbl_cos_bell_q2')
+  CASE(4)
+     PRINT *, 'Double cosine bell'
+     CALL cosine_bell_2(q)      
+  CASE(5)
      CALL cosine_bell_2(q) 
      DO l=1,llm
         q(:,l)= 0.9 - 0.8*q(:,l)*q(:,l)
-     END DO
-     
-  CASE('complement')
+     END DO     
+  CASE(6)
      ! tracer such that, in combination with the other tracer fields 
      ! with weight (3/10), the sum is equal to one
@@ -123 +154 @@
      CALL slotted_cylinders(qxt1)
      q = q + qxt1 
-     q = 1. - q*0.3  
-     
-  CASE('hadley')  ! hadley like meridional circulation 
+     q = 1. - q*0.3
+  CASE(7)  ! hadley like meridional circulation 
      CALL hadleyq(q) 
-     
-  CASE DEFAULT
-     PRINT *, 'Bad selector for variable ncar_adv_shape : <', TRIM(ncar_adv_shape),   &
-          '> options are <const>, <slotted_cyl>, <cos_bell>, <dbl_cos_bell_q1>', &
-          '<dbl_cos_bell_q2>, <complement>, <hadley>'
-     STOP
-     
   END SELECT
       
@@ -228 +251 @@
             IF ( zrl(l) .GT. zc ) Then 
               IF ( ABS(latc1 - lat) .LT. 0.125 ) Then 
-                hx(n,l)= 0.0
+                hx(n,l)= 0.1
               ENDIF 
             ENDIF