Changeset 25 for codes/icosagcm/trunk/src/etat0_ncar.f90

Timestamp:

07/26/12 04:05:44 (12 years ago)

Author:

dubos

Message:

Minor changes :
caldyn_sw.f90, advect_tracer.f90
icosa_mod.f90 : added parameters for NCAR test cases needing global scope
guided_mod.f90 : CALL to guided_ncar now takes tt=it*dt instead of it as input

Significant changes :
timeloop_gcm.f90 : re-activated CALL to advection scheme
disvert_ncar.f90,
etat0_ncar.f90
guided_ncar_mod.f90 : simplification, introduced several getin(...), update due to recent changes in advection test cases (deformational flow, Hadley cell)
run_adv.def : new keys, reorganized for legibility

Tests :
icosa_gcm.exe tested with ncar_adv_shape=const and ncar_adv_wind=solid,deform,hadley.
q1=1 maintained to machine accuracy. Surface pressure slightly oscillates as expected.

FIXME : Tests by Sarvesh with revision 24 show incorrect advection of cosine bell by solid-body rotation. Not fixed.

File:

• codes/icosagcm/trunk/src/etat0_ncar.f90 (modified) (2 diffs)

codes/icosagcm/trunk/src/etat0_ncar.f90

@@ -19 +19 @@
   REAL(rstd), PARAMETER :: rt=radius*0.5
   REAL(rstd), PARAMETER :: zc=5000.0
-  REAL(rstd), PARAMETER :: ps0=100000.0
-  REAL(rstd), PARAMETER :: T0=300
-  REAL(rstd), PARAMETER :: R_d=287.0   
 
   PUBLIC etat0
@@ -78 +75 @@
   REAL(rstd) :: X2(3),X1(3)
   INTEGER :: i,j,n,l
-  INTEGER :: testcase
-
-    u = 0.0 ; phis = 0 ; theta_rhodz = 0 ; ps = ps0
-        
-    DO l=1, llm+1
-      pr = ap(l) + bp(l)*ps0
-      zr(l) = -R_d*T0/g*log(pr/ps0) 
-    ENDDO    
-
-    DO l=1, llm 
-      zrl(l) = 0.5*(zr(l) + zr(l+1)) 
-    END DO
-
-    testcase=5
-    CALL getin('ncar_test_case',testcase)
- 
-    SELECT CASE(testcase)
-!--------------------------------------------- SINGLE COSINE BELL
-      CASE(0)
-        CALL cosine_bell_1(q) 
-        
-      CASE(1)
-        CALL cosine_bell_2(q) 
-        
-      CASE(2)
-        CALL cosine_bell_2(q) 
-        DO l=1,llm
-          q(:,l)= 0.9 - 0.8*q(:,l)*q(:,l)
-        END DO  
-        
-      CASE(3)
-        CALL slotted_cylinders(q)       
-
-      CASE(4) 
-        CALL cosine_bell_2(qxt1)
-        DO l = 1,llm
-          q(:,l) = 0.9 - 0.8*qxt1(:,l)*qxt1(:,l)  
-        END DO 
-        q = q + qxt1 
-        CALL slotted_cylinders(qxt1)
-        q = q + qxt1 
-        q = 1. - q*0.3  
-         
-      CASE(5)  ! hadley like meridional circulation 
-        CALL hadleyq(q) 
-        
-      CASE DEFAULT
-        PRINT*,"no such initial profile"
-        STOP
-        
-      END SELECT
- 
-  CONTAINS
+  CHARACTER(len=255) :: ncar_adv_shape
+
+  u = 0.0 ; phis = 0 ; theta_rhodz = 0 ; ps = ncar_p0
+  
+  DO l=1, llm+1
+     pr = ap(l) + bp(l)*ncar_p0
+     zr(l) = -kappa*cpp*ncar_T0/g*log(pr/ncar_p0) 
+  ENDDO
+  
+  DO l=1, llm 
+     zrl(l) = 0.5*(zr(l) + zr(l+1)) 
+  END DO
+  
+  ncar_adv_shape='cos_bell'
+  CALL getin('ncar_adv_shape',ncar_adv_shape)
+  
+  SELECT CASE(TRIM(ncar_adv_shape))
+     !--------------------------------------------- SINGLE COSINE BELL
+  CASE('const')
+     q=1
+  CASE('cos_bell')
+     CALL cosine_bell_1(q) 
+     
+  CASE('slotted_cyl')
+     CALL slotted_cylinders(q)  
+     
+  CASE('dbl_cos_bell_q1')
+     CALL cosine_bell_2(q) 
+     
+  CASE('dbl_cos_bell_q2')
+     CALL cosine_bell_2(q) 
+     DO l=1,llm
+        q(:,l)= 0.9 - 0.8*q(:,l)*q(:,l)
+     END DO
+     
+  CASE('complement')
+     ! tracer such that, in combination with the other tracer fields 
+     ! with weight (3/10), the sum is equal to one
+     CALL cosine_bell_2(qxt1)
+     DO l = 1,llm
+        q(:,l) = 0.9 - 0.8*qxt1(:,l)*qxt1(:,l)  
+     END DO
+     q = q + qxt1 
+     CALL slotted_cylinders(qxt1)
+     q = q + qxt1 
+     q = 1. - q*0.3  
+     
+  CASE('hadley')  ! 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
+      
+CONTAINS
 
 !======================================================================