Index: codes/icosagcm/trunk/src/physics_dcmip.f90
===================================================================
--- codes/icosagcm/trunk/src/physics_dcmip.f90	(revision 192)
+++ codes/icosagcm/trunk/src/physics_dcmip.f90	(revision 196)
@@ -6,134 +6,58 @@
 !$OMP THREADPRIVATE(testcase)
 
-  PUBLIC init_physics, physics
   TYPE(t_field),POINTER :: f_out_i(:)
   TYPE(t_field),POINTER :: f_precl(:)
-    REAL(rstd),POINTER :: out_i(:,:)
+  REAL(rstd),POINTER :: out_i(:,:)
+
+  PUBLIC :: compute_phys_wrap, init_physics
 
 CONTAINS
 
   SUBROUTINE init_physics
-  IMPLICIT NONE
-
+    IMPLICIT NONE
     testcase=1 ! OK for 4.2 (moist baroclinic instability)
     CALL getin("dcmip_physics",testcase)
-    CALL allocate_field(f_out_i,field_t,type_real,llm)
-    CALL allocate_field(f_precl,field_t,type_real)
-        
   END SUBROUTINE init_physics
 
-
-  SUBROUTINE physics( it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
-  USE icosa
-  IMPLICIT NONE
-    INTEGER,INTENT(IN)    :: it
-    TYPE(t_field),POINTER :: f_phis(:)
-    TYPE(t_field),POINTER :: f_ps(:)
-    TYPE(t_field),POINTER :: f_theta_rhodz(:)
-    TYPE(t_field),POINTER :: f_ue(:)
-    TYPE(t_field),POINTER :: f_q(:)
-  
-    REAL(rstd),POINTER :: phis(:)
-    REAL(rstd),POINTER :: ps(:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:)
-    REAL(rstd),POINTER :: ue(:,:)
-    REAL(rstd),POINTER :: q(:,:,:)
-    REAL(rstd),POINTER :: precl(:)
-    INTEGER :: ind
-
-    CALL transfert_request(f_ue,req_e1_vect)
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)) CYCLE
-      CALL swap_dimensions(ind)
-      CALL swap_geometry(ind)
-      
-      phis=f_phis(ind)
-      ps=f_ps(ind)
-      theta_rhodz=f_theta_rhodz(ind)
-      ue=f_ue(ind)
-      q=f_q(ind)
-      out_i=f_out_i(ind)
-      precl=f_precl(ind)
-    
-      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
-      CALL writefield("precl",f_precl)
-    ENDIF
-
-  END SUBROUTINE physics
-  
-  SUBROUTINE compute_physics(phis, ps, theta_rhodz, ue, q, precl)
-  USE icosa
-  USE pression_mod
-  USE exner_mod
-  USE theta2theta_rhodz_mod
-  USE geopotential_mod
-  USE wind_mod
-  IMPLICIT NONE
-    REAL(rstd) :: phis(iim*jjm)
-    REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd) :: ue(3*iim*jjm,llm)
-    REAL(rstd) :: q(iim*jjm,llm)
-    REAL(rstd) :: precl(iim*jjm)
-
-    REAL(rstd) :: p(iim*jjm,llm+1)
-    REAL(rstd) :: pks(iim*jjm)
-    REAL(rstd) :: pk(iim*jjm,llm)
-    REAL(rstd) :: phi(iim*jjm,llm)
-    REAL(rstd) :: T(iim*jjm,llm)
-    REAL(rstd) :: Tfi(iim*jjm,llm)
-    REAL(rstd) :: theta(iim*jjm,llm)
-
-   REAL(rstd) :: uc(iim*jjm,3,llm)
-   REAL(rstd) :: u(iim*jjm,llm)
-   REAL(rstd) :: v(iim*jjm,llm)
-    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
-     
-!    PRINT *,'Entering in DCMIP physics'    
-    CALL compute_pression(ps,p,0)
-    CALL compute_exner(ps,p,pks,pk,0)
-    CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,0)
-    CALL compute_geopotential(phis,pks,pk,theta,phi,0)
-    CALL compute_theta_rhodz2temperature(ps,theta_rhodz,T,0)
-    ! Reconstruct wind vector at hexagons
-    CALL compute_wind_centered(ue,uc)
-    CALL compute_wind_centered_lonlat_compound(uc, u, v)
-
-    ! Convert from Tv to T
-    DO l=1,llm
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          T(ij,l)=T(ij,l)/(1+0.608*q(ij,l))
-        ENDDO
-      ENDDO
-    ENDDO       
-    
-    DO j=jj_begin,jj_end
-      DO i=ii_begin,ii_end
-        ij=(j-1)*iim+i
-        CALL xyz2lonlat(xyz_i(ij,:),lon,lat(ij)) 
-      ENDDO
-    ENDDO
-   
-    ! bottom-up indexing (DYNAMICO) : u,utemp, v,vtemp                                                                     
-    ! top-down vertical indexing (DCMIP) : ufi, vfi, ...                                                             
-    ! => copy fields and mirror vertical index                                                       
+  SUBROUTINE compute_phys_wrap(args)
+    USE physics_interface_mod
+    TYPE(physics_inout) :: args
+    CALL compute_physics(args%ngrid, args%dt_phys, args%lat, &
+         args%p, args%Temp, args%ulon, args%ulat, args%q(:,:,1), &
+         args%dTemp, args%dulon, args%dulat, args%dq(:,:,1), args%extra_2D(:,1))
+  END SUBROUTINE compute_phys_wrap
+
+  SUBROUTINE compute_physics(ngrid,dt_phys,lat, p,Temp,u,v,q, dTemp,du,dv,dq, precl)
+    USE icosa
+    IMPLICIT NONE
+    INTEGER    :: ngrid
+    REAL(rstd) :: lat(ngrid)
+    REAL(rstd) :: ps(ngrid)
+    REAL(rstd) :: precl(ngrid)
+    ! arguments with bottom-up indexing (DYNAMICO)
+    REAL(rstd) :: p(ngrid,llm+1)
+    REAL(rstd) :: Temp(ngrid,llm)
+    REAL(rstd) :: u(ngrid,llm)
+    REAL(rstd) :: v(ngrid,llm)
+    REAL(rstd) :: q(ngrid,llm)
+    REAL(rstd) :: dTemp(ngrid,llm)
+    REAL(rstd) :: du(ngrid,llm)
+    REAL(rstd) :: dv(ngrid,llm)
+    REAL(rstd) :: dq(ngrid,llm)
+    ! local arrays with top-down vertical indexing (DCMIP)
+    REAL(rstd) :: pint(ngrid,llm+1)
+    REAL(rstd) :: pmid(ngrid,llm)
+    REAL(rstd) :: pdel(ngrid,llm)
+    REAL(rstd) :: Tfi(ngrid,llm)
+    REAL(rstd) :: ufi(ngrid,llm)
+    REAL(rstd) :: vfi(ngrid,llm)
+    REAL(rstd) :: qfi(ngrid,llm)
+
+    INTEGER :: i,j,l,ll,ij
+    REAL(rstd) :: dt_phys, inv_dt
+
+    ! prepare input fields and mirror vertical index      
+    ps(:) = p(:,1) ! surface pressure
+
     DO l=1,llm+1
       DO j=jj_begin,jj_end
@@ -144,95 +68,40 @@
       ENDDO
     ENDDO
-    
-    ! Pressure inside layers                                                                                             
+
     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*(pint(ij,l)+pint(ij,l+1)) 
-        ENDDO
-      ENDDO
+       ll=llm+1-l
+       DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             pmid(ij,l)=0.5*(pint(ij,l)+pint(ij,l+1)) ! Pressure inside layers
+             pdel(ij,l)=pint(ij,l+1)-pint(ij,l)       ! Pressure difference between two layers
+             ufi(ij,l)=u(ij,ll)
+             vfi(ij,l)=v(ij,ll)
+             qfi(ij,l)=q(ij,ll)
+             Tfi(ij,l)=Temp(ij,ll)/(1+0.608*qfi(ij,l))
+          ENDDO
+       ENDDO
     ENDDO
     
-    ! Pressure difference between two layers
+    CALL simple_physics(ngrid, llm, dt_phys, lat, tfi, qfi , ufi, vfi, pmid, pint, pdel, 1./pdel, ps, precl, testcase) 
+    
+    ! Mirror vertical index and compute tendencies
+    inv_dt = 1./dt_phys
     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
-    ENDDO       
-       
-    ! Copy T,u,v,q for input to physics
-    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       
-    
-    CALL simple_physics(iim*jjm, llm, dt, lat, tfi, qfi , ufi, vfi, pmid, pint, pdel, 1/pdel, ps, precl, testcase) 
-    
-    ! Copy back T,u,v,q and mirror vertical index
-    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       
-
-
-    ! Convert back T to Tv
-    DO l=1,llm
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          T(ij,l)=T(ij,l)*(1+0.608*q(ij,l))
-        ENDDO
-      ENDDO
-    ENDDO       
-
-    ! Compute velocity update at hexagons                                                                                
-    utemp=utemp-u
-    vtemp=vtemp-v
-
-    ! lon-lat -> 3D
-    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
+       ll=llm+1-l
+       DO j=jj_begin,jj_end
+          DO i=ii_begin,ii_end
+             ij=(j-1)*iim+i
+             dTemp(ij,l) = inv_dt * ( Tfi(ij,ll)*(1+0.608*qfi(ij,ll)) - Temp(ij,l) )
+             du(ij,l) = inv_dt * (ufi(ij,ll) - u(ij,l))
+             dv(ij,l) = inv_dt * (vfi(ij,ll) - v(ij,l))
+             dq(ij,l)  = inv_dt * (qfi(ij,ll) - q(ij,l))
+          ENDDO
+       ENDDO
     ENDDO
-
-    ! Update velocity at velocity points
-    DO l=1,llm
-      DO j=jj_begin,jj_end
-        DO i=ii_begin,ii_end
-          ij=(j-1)*iim+i
-          ue(ij+u_right,l)=ue(ij+u_right,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
-          ue(ij+u_lup,l)=ue(ij+u_lup,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
-          ue(ij+u_ldown,l)=ue(ij+u_ldown,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
-        ENDDO
-      ENDDO
-    ENDDO
-   
-    CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,0)
-
 
   END SUBROUTINE compute_physics
    
+END MODULE physics_dcmip_mod
 
 subroutine simple_physics (pcols, pver, dtime, lat, t, q, u, v, pmid, pint, pdel, rpdel, ps, precl, test)
@@ -501,5 +370,5 @@
          do i=1,pcols
             qsat = epsilo*e0/pmid(i,k)*exp(-latvap/rh2o*((1._r8/t(i,k))-1._r8/T0))  ! saturation specific humidity
-            out_i(i,llm+1-k)=q(i,k)-qsat
+!            out_i(i,llm+1-k)=q(i,k)-qsat
             if (q(i,k) > qsat) then                                                 ! saturated?
                tmp  = 1._r8/dtime*(q(i,k)-qsat)/(1._r8+(latvap/cpair)*(epsilo*latvap*qsat/(rair*t(i,k)**2)))
@@ -694,6 +563,2 @@
 end subroutine simple_physics 
 
-
-
-
-END MODULE physics_dcmip_mod
