Changeset 286 for codes/icosagcm/trunk/src/etat0_heldsz.f90

Timestamp:

10/20/14 23:42:26 (10 years ago)

Author:

dubos

Message:

Partial etat0 cleanup (removed calls to xyz2lonlat)

File:

• codes/icosagcm/trunk/src/etat0_heldsz.f90 (modified) (10 diffs)

codes/icosagcm/trunk/src/etat0_heldsz.f90

@@ -6 +6 @@
   TYPE(t_field),POINTER :: f_theta_eq(:)
   TYPE(t_field),POINTER :: f_theta(:)
-  TYPE(t_field),POINTER :: f_clat(:) ! FIXME, duplication
 
   REAL(rstd),ALLOCATABLE,SAVE :: knewt_t(:),kfrict(:)
@@ -65 +64 @@
     REAL(rstd),POINTER :: u(:,:)
     REAL(rstd),POINTER :: q(:,:,:)
-    REAL(rstd),POINTER :: clat(:) 
     REAL(rstd),POINTER :: theta_eq(:,:) 
     REAL(rstd),POINTER :: theta(:,:) 
@@ -78 +76 @@
 
        theta_eq=f_theta_eq(ind) 
-       clat=f_clat(ind) 
-       CALL compute_Teq(clat,theta_eq) ! FIXME : already done by Init_Teq
+       CALL compute_Teq(lat_i,theta_eq) ! FIXME : already done by Init_Teq
 
        ps=f_ps(ind)
@@ -111 +108 @@
        CALL allocate_field(f_theta,field_t,type_real,llm)
        CALL allocate_field(f_theta_eq,field_t,type_real,llm)
-       CALL allocate_field(f_clat,field_t,type_real)
        ALLOCATE(knewt_t(llm)); ALLOCATE( kfrict(llm)) 
 
@@ -147 +143 @@
           CALL swap_dimensions(ind)
           CALL swap_geometry(ind)
-          clat=f_clat(ind)
           theta_eq=f_theta_eq(ind)
-          CALL compute_Teq(clat,theta_eq)
+          CALL compute_Teq(lat_i,theta_eq)
        ENDDO
 
@@ -159 +154 @@
   END SUBROUTINE init_Teq
 
-  SUBROUTINE compute_Teq(clat,theta_eq)
+  SUBROUTINE compute_Teq(lat,theta_eq)
     USE icosa
     USE disvert_mod
     IMPLICIT NONE  
-    REAL(rstd),INTENT(OUT) :: clat(iim*jjm)
+    REAL(rstd),INTENT(IN) :: lat(iim*jjm)
     REAL(rstd),INTENT(OUT) :: theta_eq(iim*jjm,llm) 
 
-    REAL(rstd) :: lon, lat, r, zsig, ddsin, tetastrat, tetajl
-    REAL(rstd) :: slat(iim*jjm) 
+    REAL(rstd) :: r, zsig, ddsin, tetastrat, tetajl
     INTEGER :: i,j,l,ij
-
-    DO j=jj_begin-1,jj_end+1
-       DO i=ii_begin-1,ii_end+1
-          ij=(j-1)*iim+i
-          CALL xyz2lonlat(xyz_i(ij,:),lon,lat)
-          clat(ij)=cos(lat) 
-          slat(ij)=sin(lat) 
-       ENDDO
-    ENDDO
 
     DO l=1,llm
@@ -185 +170 @@
           DO i=ii_begin-1,ii_end+1
              ij=(j-1)*iim+i
-             ddsin=slat(ij) 
+             ddsin=SIN(lat(ij)) 
              tetajl=teta0-delt_y*ddsin*ddsin+eps*ddsin &
                   -delt_z*(1.-ddsin*ddsin)*log(zsig)
@@ -244 +229 @@
        theta_eq=f_theta_eq(ind) 
        theta=f_theta(ind) 
-       clat=f_clat(ind) 
-       CALL compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta) 
+       CALL compute_heldsz(ps,theta_eq,lat_i, theta_rhodz,u, theta) 
     ENDDO
   END SUBROUTINE held_suarez
 
-  SUBROUTINE compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta) 
+  SUBROUTINE compute_heldsz(ps,theta_eq,lat, theta_rhodz,u, theta) 
     USE icosa
     USE theta2theta_rhodz_mod
@@ -255 +239 @@
     REAL(rstd),INTENT(IN)    :: ps(iim*jjm) 
     REAL(rstd),INTENT(IN)    :: theta_eq(iim*jjm,llm) 
-    REAL(rstd),INTENT(IN)    :: clat(iim*jjm) 
+    REAL(rstd),INTENT(IN)    :: lat(iim*jjm) 
     REAL(rstd),INTENT(INOUT) :: theta_rhodz(iim*jjm,llm)
     REAL(rstd),INTENT(INOUT) :: u(3*iim*jjm,llm)
@@ -268 +252 @@
              ij=(j-1)*iim+i
              theta(ij,l)=theta(ij,l) - dt*(theta(ij,l)-theta_eq(ij,l))* &
-                  (knewt_g+knewt_t(l)*clat(ij)**4 )
+                  (knewt_g+knewt_t(l)*COS(lat(ij))**4 )
           ENDDO
        ENDDO