Changeset 164

Timestamp:

06/29/13 02:30:24 (11 years ago)

Author:

dubos

Message:

Williamson (1991) test case

Location:

codes/icosagcm/trunk/src

Files:

• etat0.f90 (modified) (2 diffs)
• etat0_williamson.f90 (modified) (3 diffs)

codes/icosagcm/trunk/src/etat0.f90

@@ -7 +7 @@
     USE icosa
     USE disvert_mod
+    USE etat0_williamson_mod, ONLY : etat0_williamson_new
     USE etat0_jablonowsky06_mod, ONLY : etat0_jablonowsky06=>etat0
     USE etat0_academic_mod, ONLY : etat0_academic=>etat0  
@@ -41 +42 @@
     
     SELECT CASE (TRIM(etat0_type))
+    CASE ('williamson91.5')
+       CALL etat0_williamson_new(f_phis,f_mass,f_theta_rhodz,f_u, f_q)
+       init_mass=.FALSE.
     CASE ('jablonowsky06')
        CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)

codes/icosagcm/trunk/src/etat0_williamson.f90

@@ -7 +7 @@
     REAL(rstd), PARAMETER :: omega0=K0
     
-  PUBLIC  etat0_williamson, compute_etat0_williamson
+    PUBLIC  etat0_williamson, etat0_williamson_new
+    
 CONTAINS
   
@@ -30 +31 @@
 
   END SUBROUTINE etat0_williamson 
+  
+  SUBROUTINE etat0_williamson_new(f_phis,f_mass,f_theta_rhodz,f_u, f_q)
+  USE icosa
+  USE mpipara, ONLY : is_mpi_root
+  USE disvert_mod, ONLY : caldyn_eta, eta_lag
+
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_phis(:)
+    TYPE(t_field),POINTER :: f_mass(:)
+    TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_u(:)
+    TYPE(t_field),POINTER :: f_q(:)
+  
+    REAL(rstd),POINTER :: phis(:)
+    REAL(rstd),POINTER :: h(:,:)
+    REAL(rstd),POINTER :: theta_rhodz(:,:)
+    REAL(rstd),POINTER :: u(:,:)
+    INTEGER :: ind
+
+    IF(caldyn_eta /= eta_lag) THEN
+       IF(is_mpi_root) PRINT *, 'etat0_type=williamson91.5 (Williamson,1991) must be used with caldyn_eta=eta_lag'
+       STOP
+    END IF
+
+    IF(llm>1) THEN
+       IF(is_mpi_root) PRINT *, 'etat0_type=williamson91.5 (Williamson,1991) must be used with llm=1 but llm =',llm
+       STOP
+    END IF
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      h=f_mass(ind)
+      u=f_u(ind)
+      theta_rhodz=f_theta_rhodz(ind)
+      phis=f_phis(ind)
+      CALL compute_etat0_williamson(h(:,1), u(:,1))
+      phis(:)=0.
+      theta_rhodz(:,:) = h(:,:)
+    ENDDO
+
+  END SUBROUTINE etat0_williamson_new
   
   SUBROUTINE compute_etat0_williamson(hi, ue)
@@ -97 +140 @@
     ENDDO
 
-    de_min=1e10
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        n=(j-1)*iim+i
-        de_min=MIN(de_min,de(n+u_right),de(n+u_rup),de(n+u_lup),de(n+u_left),de(n+u_ldown),de(n+u_rdown))
-      ENDDO
-     ENDDO
-    PRINT *,"-----> de min :",de_min 
-  
   CONTAINS