Changeset 132 for codes/icosagcm/trunk/src/advect_tracer.f90

Timestamp:

02/09/13 02:01:07 (11 years ago)

Author:

dubos

Message:

Some steps towards coupling with transport

File:

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

codes/icosagcm/trunk/src/advect_tracer.f90

@@ -8 +8 @@
   TYPE(t_field),POINTER :: f_gradq3d(:)
 
-  PUBLIC init_advect_tracer, advect_tracer
+  PUBLIC init_advect_tracer, advect_tracer_rhodz, advect_tracer
 
 CONTAINS
@@ -32 +32 @@
 
   END SUBROUTINE init_advect_tracer
+
+  SUBROUTINE advect_tracer_rhodz(f_ps, f_rhodz)
+    USE icosa
+    USE advect_mod
+    USE disvert_mod
+    USE mpipara
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: f_ps(:)     ! surface pressure, IN
+    TYPE(t_field),POINTER :: f_rhodz(:)  ! mass, OUT
+    REAL(rstd),POINTER :: rhodz(:,:) 
+    REAL(rstd),POINTER :: ps(:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       rhodz=f_rhodz(ind)
+       ps=f_ps(ind)
+       CALL compute_rhodz(ps,rhodz)
+    END DO
+  END SUBROUTINE advect_tracer_rhodz
+
+  SUBROUTINE compute_rhodz(ps, rhodz)
+    USE icosa
+    USE disvert_mod
+    REAL(rstd), INTENT(IN) :: ps(iim*jjm)
+    REAL(rstd), INTENT(OUT) :: rhodz(iim*jjm,llm)
+    INTEGER :: l,i,j,ij
+    DO l = 1, llm
+       DO j=jj_begin-1,jj_end+1
+          DO i=ii_begin-1,ii_end+1
+             ij=(j-1)*iim+i
+             rhodz(ij,l) = (ap(l) - ap(l+1) + (bp(l)-bp(l+1))*ps(ij))/g 
+          ENDDO
+       ENDDO
+    ENDDO
+  END SUBROUTINE compute_rhodz
 
   SUBROUTINE advect_tracer(f_ps,f_u,f_q)