Changeset 1363 for LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/exner_hyb_p.F

Timestamp:

Apr 16, 2010, 11:50:10 AM (14 years ago)

Author:

Ehouarn Millour

Message:

Added possibility to run in "Shallow Water" mode. SW mode is automatically set if the number of atmospheric layers is 1.
To use SW mode, the model should be compiled without physics (makelmdz_fcm -p nophys) and/or without calls to the physics (i.e. set iflag_phys=0 in gcm.def).

-Updated some definitions and comments in run.def & gcm.def

-Fixed misplaced #ifdef CPP_EARTH in calfis.F + some write(lunout,*)

-Specific initialisation of fields for SW are done in sw_case_williamson91_6 (called by iniacademic, when read_start=.false.)

• Checked (on Vargas & Brodie) that these changes don't alter usual bench GCM outputs.

EM

File:

• LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/exner_hyb_p.F (modified) (2 diffs)

LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/exner_hyb_p.F

@@ +1 @@
+!
+! $Id $
+!
       SUBROUTINE  exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
 c
@@ -51 +54 @@
       INTEGER ije,ijb,jje,jjb
 c
-c$OMP BARRIER           
+c$OMP BARRIER
+
+      if (llm.eq.1) then
+        ! Specific behaviour for Shallow Water (1 vertical layer) case
+      
+        ! Sanity checks
+        if (kappa.ne.1) then
+          call abort_gcm("exner_hyb",
+     &    "kappa!=1 , but running in Shallow Water mode!!",42)
+        endif
+        if (cpp.ne.r) then
+        call abort_gcm("exner_hyb",
+     &    "cpp!=r , but running in Shallow Water mode!!",42)
+        endif
+        
+        ! Compute pks(:),pk(:),pkf(:)
+        ijb=ij_begin
+        ije=ij_end
+!$OMP DO SCHEDULE(STATIC)
+        DO ij=ijb, ije
+          pks(ij)=(cpp/preff)*ps(ij)
+          pk(ij,1) = .5*pks(ij)
+          pkf(ij,1)=pk(ij,1)
+        ENDDO
+!$OMP ENDDO
+
+!$OMP MASTER
+      if (pole_nord) then
+        DO  ij   = 1, iim
+          ppn(ij) = aire(   ij   ) * pks(  ij     )
+        ENDDO
+        xpn      = SSUM(iim,ppn,1) /apoln
+  
+        DO ij   = 1, iip1
+          pks(   ij     )  =  xpn
+          pk(ij,1) = .5*pks(ij)
+          pkf(ij,1)=pk(ij,1)
+        ENDDO
+      endif
+      
+      if (pole_sud) then
+        DO  ij   = 1, iim
+          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+        ENDDO
+        xps      = SSUM(iim,pps,1) /apols 
+  
+        DO ij   = 1, iip1
+          pks( ij+ip1jm )  =  xps
+          pk(ij+ip1jm,1)=.5*pks(ij+ip1jm)
+          pkf(ij+ip1jm,1)=pk(ij+ip1jm,1)
+        ENDDO
+      endif
+!$OMP END MASTER
+
+        jjb=jj_begin
+        jje=jj_end
+        CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
+
+        ! our work is done, exit routine
+        return
+      endif ! of if (llm.eq.1)
+
+
       unpl2k    = 1.+ 2.* kappa
 c