Changeset 5114 for LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90

Timestamp:

Jul 24, 2024, 1:27:51 PM (8 weeks ago)

Author:

abarral

Message:

Rename modules in misc from *_mod > lmdz_*
Turn description.h into lmdz_description.f90

File:

• LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90 (modified) (12 diffs)

LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90

@@ -1 @@
-
 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
 
-SUBROUTINE writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, &
-        masse,ps,phis)
+SUBROUTINE writedynav_loc(time, vcov, ucov, teta, ppk, phi, q, &
+        masse, ps, phis)
 
   ! This routine needs IOIPSL
@@ -10 +9 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid
+  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
+  USE lmdz_description, ONLY: descript
 
   IMPLICIT NONE
@@ -45 +45 @@
   include "paramet.h"
   include "comgeom.h"
-  include "description.h"
   include "iniprint.h"
 
@@ -52 +51 @@
   !
 
-  REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-  REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
-  REAL :: ppk(ijb_u:ije_u,llm)
-  REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)
+  REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
+  REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
+  REAL :: ppk(ijb_u:ije_u, llm)
+  REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
   REAL :: phis(ijb_u:ije_u)
-  REAL :: q(ijb_u:ije_u,llm,nqtot)
+  REAL :: q(ijb_u:ije_u, llm, nqtot)
   integer :: time
 
@@ -64 +63 @@
   !   Variables locales
   !
-  INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
+  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
   INTEGER :: iq, ii, ll
-  REAL,SAVE,ALLOCATABLE :: tm(:,:)
-  REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
+  REAL, SAVE, ALLOCATABLE :: tm(:, :)
+  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
   logical :: ok_sync
   integer :: itau_w
-  integer :: ijb,ije,jjn
-  LOGICAL,SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
+  integer :: ijb, ije, jjn
+  LOGICAL, SAVE :: first = .TRUE.
+  !$OMP THREADPRIVATE(first)
 
   !
@@ -80 +79 @@
 
   IF (first) THEN
-!$OMP BARRIER
-!$OMP MASTER
-    ALLOCATE(unat(ijb_u:ije_u,llm))
-    ALLOCATE(vnat(ijb_v:ije_v,llm))
-    ALLOCATE(tm(ijb_u:ije_u,llm))
-    ALLOCATE(ndex2d(ijnb_u*llm))
-    ALLOCATE(ndexu(ijnb_u*llm))
-    ALLOCATE(ndexv(ijnb_v*llm))
+    !$OMP BARRIER
+    !$OMP MASTER
+    ALLOCATE(unat(ijb_u:ije_u, llm))
+    ALLOCATE(vnat(ijb_v:ije_v, llm))
+    ALLOCATE(tm(ijb_u:ije_u, llm))
+    ALLOCATE(ndex2d(ijnb_u * llm))
+    ALLOCATE(ndexu(ijnb_u * llm))
+    ALLOCATE(ndexv(ijnb_v * llm))
     ndex2d = 0
     ndexu = 0
     ndexv = 0
-!$OMP END MASTER
-!$OMP BARRIER
-    first=.FALSE.
+    !$OMP END MASTER
+    !$OMP BARRIER
+    first = .FALSE.
   ENDIF
 
@@ -108 +107 @@
   !
 
-!$OMP BARRIER
-!$OMP MASTER
-  ijb=ij_begin
-  ije=ij_end
-  jjn=jj_nb
-
-  CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:), &
-        iip1*jjn*llm, ndexu)
-!$OMP END MASTER
+  !$OMP BARRIER
+  !$OMP MASTER
+  ijb = ij_begin
+  ije = ij_end
+  jjn = jj_nb
+
+  CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije, :), &
+          iip1 * jjn * llm, ndexu)
+  !$OMP END MASTER
 
   !
   !  Vents V
   !
-  ije=ij_end
-  if (pole_sud) jjn=jj_nb-1
-  if (pole_sud) ije=ij_end-iip1
-!$OMP BARRIER
-!$OMP MASTER
-  CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:), &
-        iip1*jjn*llm, ndexv)
-!$OMP END MASTER
+  ije = ij_end
+  if (pole_sud) jjn = jj_nb - 1
+  if (pole_sud) ije = ij_end - iip1
+  !$OMP BARRIER
+  !$OMP MASTER
+  CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije, :), &
+          iip1 * jjn * llm, ndexv)
+  !$OMP END MASTER
 
 
@@ -134 +133 @@
   !  Temperature potentielle moyennee
   !
-  ijb=ij_begin
-  ije=ij_end
-  jjn=jj_nb
-!$OMP MASTER
-  CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:), &
-        iip1*jjn*llm, ndexu)
-!$OMP END MASTER
+  ijb = ij_begin
+  ije = ij_end
+  jjn = jj_nb
+  !$OMP MASTER
+  CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije, :), &
+          iip1 * jjn * llm, ndexu)
+  !$OMP END MASTER
 
   !
@@ -146 +145 @@
   !
 
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-  do ll=1,llm
+  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  do ll = 1, llm
     do ii = ijb, ije
-      tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
+      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
     enddo
   enddo
-!$OMP ENDDO
-
-!$OMP MASTER
-  CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:), &
-        iip1*jjn*llm, ndexu)
-!$OMP END MASTER
+  !$OMP ENDDO
+
+  !$OMP MASTER
+  CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije, :), &
+          iip1 * jjn * llm, ndexu)
+  !$OMP END MASTER
 
 
@@ -163 +162 @@
   !  Geopotentiel
   !
-!$OMP MASTER
-  CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:), &
-        iip1*jjn*llm, ndexu)
-!$OMP END MASTER
+  !$OMP MASTER
+  CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), &
+          iip1 * jjn * llm, ndexu)
+  !$OMP END MASTER
 
 
@@ -183 +182 @@
   !  Masse
   !
-!$OMP MASTER
-   CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), &
-         iip1*jjn*llm, ndexu)
-!$OMP END MASTER
+  !$OMP MASTER
+  CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije, :), &
+          iip1 * jjn * llm, ndexu)
+  !$OMP END MASTER
 
 
@@ -192 +191 @@
   !  Pression au sol
   !
-!$OMP MASTER
-
-   CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
-         iip1*jjn, ndex2d)
-!$OMP END MASTER
+  !$OMP MASTER
+
+  CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
+          iip1 * jjn, ndex2d)
+  !$OMP END MASTER
 
   !
   !  Geopotentiel au sol
   !
-!$OMP MASTER
-    ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
+  !$OMP MASTER
+  ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
   ! .                 iip1*jjn, ndex2d)
-!$OMP END MASTER
+  !$OMP END MASTER
 
   !
   !  Fin
   !
-!$OMP MASTER
+  !$OMP MASTER
   if (ok_sync) then
-      CALL histsync(histaveid)
-      CALL histsync(histvaveid)
-      CALL histsync(histuaveid)
+    CALL histsync(histaveid)
+    CALL histsync(histvaveid)
+    CALL histsync(histuaveid)
   ENDIF
-!$OMP END MASTER
+  !$OMP END MASTER
 end subroutine writedynav_loc