Changeset 1707 for LMDZ5/branches/testing/libf/dyn3dmem/friction_loc.F

Timestamp:

Jan 11, 2013, 10:19:19 AM (11 years ago)

Author:

Laurent Fairhead

Message:

Version testing basée sur la r1706

---

Testing release based on r1706

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/dyn3dmem/friction_loc.F (modified) (3 diffs)

LMDZ5/branches/testing/libf/dyn3dmem/friction_loc.F

@@ -6 +6 @@
       USE parallel
       USE control_mod
+#ifdef CPP_IOIPSL
+      USE IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      USE ioipsl_getincom
+#endif
       IMPLICIT NONE
 
-c=======================================================================
-c
-c
-c   Objet:
-c   ------
-c
-c  ***********
-c    Friction
-c  ***********
-c
-c=======================================================================
+!=======================================================================
+!
+!   Friction for the Newtonian case:
+!   --------------------------------
+!    2 possibilities (depending on flag 'friction_type'
+!     friction_type=0 : A friction that is only applied to the lowermost
+!                       atmospheric layer
+!     friction_type=1 : Friction applied on all atmospheric layer (but
+!       (default)       with stronger magnitude near the surface; see
+!                       iniacademic.F)
+!=======================================================================
 
 #include "dimensions.h"
@@ -24 +30 @@
 #include "comgeom2.h"
 #include "comconst.h"
-
-      REAL pdt
+#include "iniprint.h"
+#include "academic.h"
+
+! arguments:
+      REAL,INTENT(inout) :: ucov( iip1,jjb_u:jje_u,llm )
+      REAL,INTENT(inout) :: vcov( iip1,jjb_v:jje_v,llm )
+      REAL,INTENT(in) :: pdt ! time step
+
+! local variables:
+
       REAL modv(iip1,jjb_u:jje_u),zco,zsi
       REAL vpn,vps,upoln,upols,vpols,vpoln
       REAL u2(iip1,jjb_u:jje_u),v2(iip1,jjb_v:jje_v)
-      REAL ucov( iip1,jjb_u:jje_u,llm ),vcov( iip1,jjb_v:jje_v,llm )
-      INTEGER  i,j
-      REAL cfric
-      parameter (cfric=1.e-5)
+      INTEGER  i,j,l
+      REAL,PARAMETER :: cfric=1.e-5
+      LOGICAL,SAVE :: firstcall=.true.
+      INTEGER,SAVE :: friction_type=1
+      CHARACTER(len=20) :: modname="friction_p"
+      CHARACTER(len=80) :: abort_message
+!$OMP THREADPRIVATE(firstcall,friction_type)
       integer :: jjb,jje
 
-
+!$OMP SINGLE
+      IF (firstcall) THEN
+        ! set friction type
+        call getin("friction_type",friction_type)
+        if ((friction_type.lt.0).or.(friction_type.gt.1)) then
+          abort_message="wrong friction type"
+          write(lunout,*)'Friction: wrong friction type',friction_type
+          call abort_gcm(modname,abort_message,42)
+        endif
+        firstcall=.false.
+      ENDIF
+!$OMP END SINGLE COPYPRIVATE(friction_type,firstcall)
+
+      if (friction_type.eq.0) then ! friction on first layer only
+!$OMP SINGLE
 c   calcul des composantes au carre du vent naturel
       jjb=jj_begin
@@ -138 +169 @@
          vcov(iip1,j,1)=vcov(1,j,1)
       enddo
+!$OMP END SINGLE
+      endif ! of if (friction_type.eq.0)
+
+      if (friction_type.eq.1) then
+       ! for ucov() 
+        jjb=jj_begin
+        jje=jj_end
+        if (pole_nord) jjb=jj_begin+1
+        if (pole_sud) jje=jj_end-1
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l=1,llm
+          ucov(1:iip1,jjb:jje,l)=ucov(1:iip1,jjb:jje,l)*
+     &                                  (1.-pdt*kfrict(l))
+        enddo
+!$OMP END DO NOWAIT
+        
+       ! for vcoc()
+        jjb=jj_begin
+        jje=jj_end
+        if (pole_sud) jje=jj_end-1
+        
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l=1,llm
+          vcov(1:iip1,jjb:jje,l)=vcov(1:iip1,jjb:jje,l)*
+     &                                  (1.-pdt*kfrict(l))
+        enddo
+!$OMP END DO
+      endif ! of if (friction_type.eq.1)
 
       RETURN