Changeset 1418 for LMDZ4/trunk/libf/dyn3d/pres2lev.F90

Timestamp:

Jul 19, 2010, 5:11:24 PM (14 years ago)

Author:

jghattas

Message:

Following bug corrections are already done at branch LMDZ4_AR5 rev
1417,1416 :

Bug corrections for nudged run (pres2lev.F90, guide_p_mod.F90) :

• now the results are the same for sequentiel and parallel mode(if adjust=n and compiled with vsafe at mercure).
• the results are the same as the sequential mode in previous revision.
• test done only with guide_u=y,guide_v=y
• copied optimized version of pres2lev.F90 from dyn3dpar to dyn3d

Added condition read_climoz for the variable O3daySTD(calcul_STDlev.h,
undefSTD.F)

Corrected bug in calculation of the diagnostic variable ec550aer
"Extinction at 550nm" (aeropt_5wv.F90) (Maria Raffaella Vuolo, LSCE)

Added stop if use_filtre_fft=y with dyn3d (conf_gcm.F) : this option is
not implemented in dyn3d.

File:

• LMDZ4/trunk/libf/dyn3d/pres2lev.F90 (moved) (moved from LMDZ4/trunk/libf/dyn3d/pres2lev.F) (1 diff)

LMDZ4/trunk/libf/dyn3d/pres2lev.F90

@@ -1 +1 @@
 ! $Id$
 !
-c******************************************************
-      SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,
-     %                      ni,nj,ok_invertp)
-c
-c interpolation lineaire pour passer
-c a une nouvelle discretisation verticale pour
-c les variables de GCM
-c Francois Forget (01/1995)
-c MOdif remy roca 12/97 pour passer de pres2sig
-c Modif F.Codron 07/08 po en 3D
-c**********************************************************
+!******************************************************
+SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
+!
+! interpolation lineaire pour passer
+! a une nouvelle discretisation verticale pour
+! les variables de GCM
+! Francois Forget (01/1995)
+! MOdif remy roca 12/97 pour passer de pres2sig
+! Modif F.Codron 07/08 po en 3D
+!**********************************************************
 
-      IMPLICIT NONE
+  IMPLICIT NONE
 
-c   Declarations:
-c ==============
-c
-c  ARGUMENTS
-c  """""""""
-       LOGICAL, INTENT(IN) :: ok_invertp
-       INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-       INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-       INTEGER lmomx ! dimensions ancienne couches
-       INTEGER lmnmx ! dimensions nouvelle couches
+!   Declarations:
+! ==============
+!
+!  ARGUMENTS
+!  """""""""
+  LOGICAL, INTENT(IN) :: ok_invertp
+  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
+  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
+  
+  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
+  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
 
-       parameter(lmomx=10000,lmnmx=10000)
+  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
 
-        real, INTENT(IN) :: po(ni,nj,lmo) ! niveau de pression ancienne grille
-        real, INTENT(IN) :: pn(ni,nj,lmn) ! niveau de pression nouvelle grille
+  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
+  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
 
-       INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontale
+  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
 
-       REAL, INTENT(IN)  :: varo(ni,nj,lmo) ! var dans l'ancienne grille
-       REAL, INTENT(OUT) :: varn(ni,nj,lmn) ! var dans la nouvelle grille
+! Autres variables
+! """"""""""""""""
+  INTEGER ::  ln ,lo, k
+  REAL    :: coef
 
-       real zvaro(lmomx),zpo(lmomx)
 
-c Autres variables
-c """"""""""""""""
-       INTEGER n, ln ,lo, i, j, Nhoriz
-       REAL coef
+! Inversion de l'ordre des niveaux verticaux
+  IF (ok_invertp) THEN
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lmo+1-lo)
+        zvaro(k,lo)=varo(k,lmo+1-lo)
+      ENDDO
+    ENDDO
+  ELSE
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lo)
+        zvaro(k,lo)=varo(k,lo)
+      ENDDO
+    ENDDO
+  ENDIF 
 
-c run
-c ====
-        do i=1,ni
-        do j=1,nj
-! Inversion de l'ordre des niveaux verticaux
-          IF (ok_invertp) THEN
-           do lo=1,lmo
-              zpo(lo)=po(i,j,lmo+1-lo)
-              zvaro(lo)=varo(i,j,lmo+1-lo)
-           enddo
-          ELSE
-           do lo=1,lmo
-              zpo(lo)=po(i,j,lo)
-              zvaro(lo)=varo(i,j,lo)
-           enddo
-          ENDIF 
+  DO ln=1,lmn
+    DO lo=1,lmo-1
+      DO k=1,ni*nj
+        IF (pn(k,ln) >= zpo(k,1) ) THEN
+          varn(k,ln) = zvaro(k,1)
+        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
+          varn(k,ln) = zvaro(k,lmo)
+        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
+          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
+          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
+        ENDIF
+         
+      ENDDO  
+    ENDDO
+  ENDDO                
 
-           do ln=1,lmn
-              if (pn(i,j,ln).ge.zpo(1))then
-                 varn(i,j,ln) =  zvaro(1)
-              else if (pn(i,j,ln).le.zpo(lmo)) then
-                 varn(i,j,ln) =  zvaro(lmo)
-              else
-                 do lo=1,lmo-1 
-                    if ( (pn(i,j,ln).le.zpo(lo)).and.
-     &                 (pn(i,j,ln).gt.zpo(lo+1)) )then
-                       coef=(pn(i,j,ln)-zpo(lo))
-     &                 /(zpo(lo+1)-zpo(lo))
-                       varn(i,j,ln)=zvaro(lo)
-     &                 +coef*(zvaro(lo+1)-zvaro(lo))
-c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
-                    end if
-                 enddo           
-              endif
-           enddo
-
-        enddo
-        enddo
-      return
-      end    
+END SUBROUTINE pres2lev