Changeset 110 for trunk/libf/dyn3dpar

Timestamp:

Apr 15, 2011, 3:44:44 PM (14 years ago)

Author:

slebonnois

Message:

SL: corrections de bugs suite a compilations venus et titan de la version 109.

Location:

trunk/libf/dyn3dpar

Files:

• disvert_noterre.F (modified) (1 diff)
• disvert_terre.F90 (modified) (1 diff)
• inidissip.F (modified) (1 diff)
• leapfrog_p.F (modified) (3 diffs)
• top_bound_p.F (modified) (3 diffs)

trunk/libf/dyn3dpar/disvert_noterre.F

@@ -199 +199 @@
 c     Specifique.  Ce choix est spécifié ici ET dans exner_hyb.F
 
-      DO l = 1, llm
+      DO l = 1, llm-1
        aps(l) =  0.5 *( ap(l) +ap(l+1)) 
        bps(l) =  0.5 *( bp(l) +bp(l+1)) 
       ENDDO
      
-      if (hybrid) then
+c     if (hybrid) then
          aps(llm) = aps(llm-1)**2 / aps(llm-2) 
          bps(llm) = 0.5*(bp(llm) + bp(llm+1))
-      else
-         bps(llm) = bps(llm-1)**2 / bps(llm-2) 
-         aps(llm) = 0.
-      end if
+c     else
+c        bps(llm) = bps(llm-1)**2 / bps(llm-2) 
+c        aps(llm) = 0.
+c     end if
 
       PRINT *,' BPs '

trunk/libf/dyn3dpar/disvert_terre.F90

@@ -140 +140 @@
   write(lunout, *) presnivs
 
-END SUBROUTINE disvert
+END SUBROUTINE disvert_terre

trunk/libf/dyn3dpar/inidissip.F

@@ -185 +185 @@
 
          write(*,*) 'Dissipation : '
-         write(*,*) 'Multiplication de la dissipation en altitude :',
+         write(*,*) 'Multiplication de la dissipation en altitude :'
          write(*,*) '  dissip_fac_mid =', dissip_fac_mid
 

trunk/libf/dyn3dpar/leapfrog_p.F

@@ -947 +947 @@
 c      -------------------
          IF (ok_strato) THEN
-           CALL top_bound_p( vcov,ucov,teta,masse,dutop,dvtop,dtetatop)
+           CALL top_bound_p( vcov,ucov,teta,phi,masse,
+     $                       dutop,dvtop,dtetatop)
            CALL addfi_p( dtphys, leapf, forward   ,
      $                  ucov, vcov, teta , q   ,ps ,
@@ -1069 +1070 @@
         ! Sponge layer (if any)
         IF (ok_strato) THEN
-          ! set dufi,dvfi,... to zero
+          ! set dutop,dvtop,... to zero
           ijb=ij_begin
           ije=ij_end
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           do l=1,llm
-            dufi(ijb:ije,l)=0
-            dtetafi(ijb:ije,l)=0
-            dqfi(ijb:ije,l,1:nqtot)=0
+            dutop(ijb:ije,l)=0
+            dtetatop(ijb:ije,l)=0
+            dqtop(ijb:ije,l,1:nqtot)=0
           enddo
 !$OMP END DO
 !$OMP SINGLE
-          dpfi(ijb:ije)=0
+          dptop(ijb:ije)=0
 !$OMP END SINGLE
           ijb=ij_begin
@@ -1087 +1088 @@
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           do l=1,llm
-            dvfi(ijb:ije,l)=0
+            dvtop(ijb:ije,l)=0
           enddo
 !$OMP END DO
 
-          CALL top_bound_p(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
+          CALL top_bound_p(vcov,ucov,teta,phi,masse,
+     $                     dutop,dvtop,dtetatop)
           CALL addfi_p( dtvr, leapf, forward   ,
      $                  ucov, vcov, teta , q   ,ps ,
-     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
+     $                 dutop, dvtop, dtetatop , dqtop ,dptop  )
 !$OMP BARRIER
         ENDIF ! of IF (ok_strato) 

trunk/libf/dyn3dpar/top_bound_p.F

@@ -1 @@
-      SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh )
+      SUBROUTINE top_bound_p( vcov,ucov,teta,phi,masse, du,dv,dh )
       USE parallel
       IMPLICIT NONE
@@ -35 +35 @@
 
       REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
+      REAL phi(iip1,jjp1,llm)                  ! geopotentiel
       REAL masse(iip1,jjp1,llm)
       REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
@@ -72 +73 @@
          print*,'TOP_BOUND mode',mode_top_bound
          print*,'Coeffs pour la couche eponge a l equateur'
-         print*,'p (Pa)  z(km)  tau (s)   dt*rdamp'
+         print*,'p (Pa)  z(km)  tau (s)'
          do l=1,llm
            if (rdamp(l).ne.0.) then
             zkm        = phi(iip1/2,jjp1/2,l)/(1000*g)
-          print*,presnivs(l),zkm,
-     .          1./rdamp(l),
-     .          dt*rdamp(l)
+          print*,presnivs(l),zkm,1./rdamp(l)
            endif
          enddo