Changeset 106

Timestamp:

08/07/12 00:02:15 (12 years ago)

Author:

ymipsl

Message:

Bug fix for DCMIP simple physics

YM

File:

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

codes/icosagcm/trunk/src/physics_dcmip.f90

@@ -40 +40 @@
     INTEGER :: ind
 
+    CALL transfert_request(f_ue,req_e1)
     DO ind=1,ndomain
       CALL swap_dimensions(ind)
@@ -52 +53 @@
       precl=f_precl(ind)
     
-      CALL compute_physics( phis, ps, theta_rhodz, ue, q(:,:,3), precl)
+      CALL compute_physics( phis, ps, theta_rhodz, ue, q(:,:,1), precl)
   
     ENDDO
+
+!    CALL writefield("out_i",f_out_i)
     
     IF (mod(it,itau_out)==0 ) THEN
@@ -82 +85 @@
     REAL(rstd) :: phi(iim*jjm,llm)
     REAL(rstd) :: T(iim*jjm,llm)
+    REAL(rstd) :: Tfi(iim*jjm,llm)
     REAL(rstd) :: theta(iim*jjm,llm)
 
@@ -89 +93 @@
     REAL(rstd) :: ufi(iim*jjm,llm)
     REAL(rstd) :: vfi(iim*jjm,llm)
+    REAL(rstd) :: qfi(iim*jjm,llm)
+    REAL(rstd) :: utemp(iim*jjm,llm)
+    REAL(rstd) :: vtemp(iim*jjm,llm)
     REAL(rstd) :: lat(iim*jjm)
     REAL(rstd) :: lon
     REAL(rstd) :: pmid(iim*jjm,llm)
+    REAL(rstd) :: pint(iim*jjm,llm+1)
     REAL(rstd) :: pdel(iim*jjm,llm)
     INTEGER :: i,j,l,ij
@@ -111 +119 @@
     ENDDO
    
-    DO l=1,llm
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          pmid(ij,l)=0.5*(p(ij,l)+p(ij,l+1)) 
+    DO l=1,llm+1
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          pint(ij,l)=p(ij,llm+2-l)
         ENDDO
       ENDDO
@@ -124 +132 @@
         DO i=ii_begin,ii_end
           ij=(j-1)*iim+i
-          pdel(ij,l)=p(ij,l+1)-p(ij,l)
+          pmid(ij,l)=0.5*(pint(ij,l)+pint(ij,l+1)) 
+        ENDDO
+      ENDDO
+    ENDDO
+    
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          pdel(ij,l)=pint(ij,l+1)-pint(ij,l)
         ENDDO
       ENDDO
@@ -130 +147 @@
        
     
-    ufi=u
-    vfi=v    
+!    ufi=u
+!    vfi=v    
     
     DO l=1,llm
@@ -142 +159 @@
     ENDDO       
     
-    
-    CALL simple_physics(iim*jjm, llm, dt, lat, t, q , ufi, vfi, pmid, p, pdel, 1/pdel, ps, precl, testcase) 
-    
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          Tfi(ij,l)=T(ij,llm+1-l)
+          ufi(ij,l)=u(ij,llm+1-l)
+          vfi(ij,l)=v(ij,llm+1-l)
+          qfi(ij,l)=q(ij,llm+1-l)
+        ENDDO
+      ENDDO
+    ENDDO       
+    
+!    q=0
+    out_i=T
+    
+    CALL simple_physics(iim*jjm, llm, dt, lat, tfi, qfi , ufi, vfi, pmid, pint, pdel, 1/pdel, ps, precl, testcase) 
+    
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          T(ij,l)=Tfi(ij,llm+1-l)
+          utemp(ij,l)=ufi(ij,llm+1-l)
+          vtemp(ij,l)=vfi(ij,llm+1-l)
+          q(ij,l)=qfi(ij,llm+1-l)
+        ENDDO
+      ENDDO
+    ENDDO       
+
+
     DO l=1,llm
       DO j=jj_begin,jj_end
@@ -153 +197 @@
       ENDDO
     ENDDO       
+
+    out_i=q
         
-    ufi=ufi-u
-    vfi=vfi-v
-
-    DO l=1,llm
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          uc(ij,:,l)=ufi(ij,l)*elon_i(ij,:)+vfi(ij,l)*elat_i(ij,:)
+    utemp=utemp-u
+    vtemp=vtemp-v
+
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          uc(ij,:,l)=utemp(ij,l)*elon_i(ij,:)+vtemp(ij,l)*elat_i(ij,:)
         ENDDO
       ENDDO
     ENDDO
 
-    out_i=ufi
+!    out_i=ufi
     
     DO l=1,llm
@@ -469 +515 @@
       end do
 
+      IF (test==0) return
 !===============================================================================
 ! Send variables to history file - THIS PROCESS WILL BE MODEL SPECIFIC