Changeset 397 for codes/icosagcm/trunk/src/pression.f90

Timestamp:

06/06/16 20:41:52 (8 years ago)

Author:

ymipsl

Message:

Prepare DCMIP2016 output by XIOS2

YM

File:

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

codes/icosagcm/trunk/src/pression.f90

@@ -25 +25 @@
   
   END SUBROUTINE pression
+
+  SUBROUTINE pression_mid(f_ps,f_pmid)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ps(:)
+    TYPE(t_field), POINTER :: f_pmid(:)
   
+    REAL(rstd), POINTER :: ps(:)
+    REAL(rstd), POINTER :: pmid(:,:)
+    INTEGER :: ind
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      ps=f_ps(ind)
+      pmid=f_pmid(ind)
+      CALL compute_pression_mid(ps, pmid,0)
+    ENDDO
+!$OMP BARRIER
+  
+  END SUBROUTINE pression_mid
+
   SUBROUTINE compute_pression(ps,p,offset)
   USE icosa
@@ -49 +72 @@
 
   END SUBROUTINE compute_pression
+  
+  SUBROUTINE compute_pression_mid(ps,pmid,offset)
+  USE icosa
+  USE disvert_mod
+  USE omp_para
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm)
+    INTEGER,INTENT(IN) :: offset
+    INTEGER :: i,j,ij,l
+
+    IF(ap_bp_present) THEN
+      DO    l    = ll_begin, ll_end
+        DO j=jj_begin-offset,jj_end+offset
+          DO i=ii_begin-offset,ii_end+offset
+            ij=(j-1)*iim+i
+            pmid(ij,l) = 0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij))
+          ENDDO
+        ENDDO
+      ENDDO
+    END IF
+
+  END SUBROUTINE compute_pression_mid
 
 END MODULE pression_mod