Changeset 2298 for LMDZ5/branches/testing/libf/phylmd/cv3a_compress.F90

Timestamp:

Jun 14, 2015, 9:13:32 PM (9 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes -r2237:2291 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/cv3a_compress.F90 (modified) (6 diffs)

LMDZ5/branches/testing/libf/phylmd/cv3a_compress.F90

@@ -1 @@
-SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
-    plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, buoybase1, &
-    t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, gz1, th1, &
-    th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
-    h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, w01, ptop21, &
-    ale1, alp1, omega1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, hnk, unk, vnk, &
-    wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, &
-    gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, h_wake, &
-    lv_wake, lf_wake, cpn_wake, tv_wake, sig, w0, ptop2, ale, alp, omega)
+SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
+                         iflag1, nk1, icb1, icbs1, &
+                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
+                         wghti1, pbase1, buoybase1, &
+                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
+                         u1, v1, gz1, th1, th1_wake, &
+                         tra1, &
+                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
+                         sig1, w01, ptop21, &
+                         Ale1, Alp1, omega1, &
+                         iflag, nk, icb, icbs, &
+                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
+                         wghti, pbase, buoybase, &
+                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
+                         u, v, gz, th, th_wake, &
+                         tra, &
+                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
+                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
+                         sig, w0, ptop2, &
+                         Ale, Alp, omega)
   ! **************************************************************
   ! *
@@ -22 +34 @@
 
   ! inputs:
-  INTEGER len, nloc, ncum, nd, ntra
-  INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
-  REAL plcl1(len), tnk1(len), qnk1(len), gznk1(len)
-  REAL hnk1(len), unk1(len), vnk1(len)
-  REAL wghti1(len, nd), pbase1(len), buoybase1(len)
-  REAL t1(len, nd), q1(len, nd), qs1(len, nd)
-  REAL t1_wake(len, nd), q1_wake(len, nd), qs1_wake(len, nd)
-  REAL s1_wake(len)
-  REAL u1(len, nd), v1(len, nd)
-  REAL gz1(len, nd), th1(len, nd), th1_wake(len, nd)
-  REAL tra1(len, nd, ntra)
-  REAL h1(len, nd), lv1(len, nd), lf1(len, nd), cpn1(len, nd)
-  REAL p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)
-  REAL tvp1(len, nd), clw1(len, nd)
-  REAL h1_wake(len, nd), lv1_wake(len, nd), cpn1_wake(len, nd)
-  REAL tv1_wake(len, nd), lf1_wake(len, nd)
-  REAL sig1(len, nd), w01(len, nd), ptop21(len)
-  REAL ale1(len), alp1(len)
-  REAL omega1(len,nd)
-
+  INTEGER, INTENT (IN)                               :: len, nloc, nd, ntra
+!jyg<
+  LOGICAL, INTENT (IN)                               :: compress  ! compression is performed if compress is true
+!>jyg
+  INTEGER, DIMENSION (len), INTENT (IN)              :: iflag1, nk1, icb1, icbs1
+  REAL, DIMENSION (len), INTENT (IN)                 :: plcl1, tnk1, qnk1, gznk1
+  REAL, DIMENSION (len), INTENT (IN)                 :: hnk1, unk1, vnk1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: wghti1(len, nd)
+  REAL, DIMENSION (len), INTENT (IN)                 :: pbase1, buoybase1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1, q1, qs1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake, q1_wake, qs1_wake
+  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1, v1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: gz1, th1, th1_wake
+  REAL, DIMENSION (len, nd,ntra), INTENT (IN)        :: tra1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1, lv1, lf1, cpn1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
+  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph1(len, nd+1)
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1, tp1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: tvp1, clw1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1_wake, lv1_wake, cpn1_wake
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1_wake, lf1_wake
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: sig1, w01
+  REAL, DIMENSION (len), INTENT (IN)                 :: ptop21
+  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1, Alp1
+  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
+!
+  ! in/out 
+  INTEGER, INTENT (INOUT)                            :: ncum
+!
   ! outputs:
   ! en fait, on a nloc=len pour l'instant (cf cv_driver)
-  INTEGER iflag(len), nk(len), icb(len), icbs(len)
-  REAL plcl(len), tnk(len), qnk(len), gznk(len)
-  REAL hnk(len), unk(len), vnk(len)
-  REAL wghti(len, nd), pbase(len), buoybase(len)
-  REAL t(len, nd), q(len, nd), qs(len, nd)
-  REAL t_wake(len, nd), q_wake(len, nd), qs_wake(len, nd)
-  REAL s_wake(len)
-  REAL u(len, nd), v(len, nd)
-  REAL gz(len, nd), th(len, nd), th_wake(len, nd)
-  REAL tra(len, nd, ntra)
-  REAL h(len, nd), lv(len, nd), lf(len, nd), cpn(len, nd)
-  REAL p(len, nd), ph(len, nd+1), tv(len, nd), tp(len, nd)
-  REAL tvp(len, nd), clw(len, nd)
-  REAL h_wake(len, nd), lv_wake(len, nd), cpn_wake(len, nd)
-  REAL tv_wake(len, nd), lf_wake(len, nd)
-  REAL sig(len, nd), w0(len, nd), ptop2(len)
-  REAL ale(len), alp(len)
-  REAL omega(len,nd)
+  INTEGER, DIMENSION (nloc), INTENT (OUT)            ::  iflag, nk, icb, icbs
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  plcl, tnk, qnk, gznk
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  hnk, unk, vnk
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  wghti
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  pbase, buoybase
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t, q, qs
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t_wake, q_wake, qs_wake
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  s_wake
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  u, v
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  gz, th, th_wake
+  REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT)      ::  tra
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h, lv, lf, cpn
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  p
+  REAL, DIMENSION (nloc, nd+1), INTENT (OUT)         ::  ph
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv, tp
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tvp, clw
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h_wake, lv_wake, cpn_wake
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv_wake, lf_wake
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  sig, w0
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  ptop2
+  REAL, DIMENSION (nloc), INTENT (OUT)               ::  Ale, Alp
+  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  omega
 
   ! local variables:
@@ -69 +95 @@
   CHARACTER (LEN=80) :: abort_message
 
+!jyg<
+  IF (compress) THEN
+!>jyg
 
   DO k = 1, nl + 1
@@ -108 +137 @@
     END DO
   END DO
-
+!
   ! AC!      do 121 j=1,ntra
   ! AC!ccccc      do 111 k=1,nl+1
@@ -146 +175 @@
       pbase(nn) = pbase1(i)
       buoybase(nn) = buoybase1(i)
+      sig(nn, nd) = sig1(i, nd)
       ptop2(nn) = ptop2(i)
-      ale(nn) = ale1(i)
-      alp(nn) = alp1(i)
+      Ale(nn) = Ale1(i)
+      Alp(nn) = Alp1(i)
     END IF
   END DO
@@ -157 +187 @@
     CALL abort_gcm(modname, abort_message, 1)
   END IF
+!
+!jyg<
+  ELSE  !(compress)
+!
+      ncum = len
+!
+      wghti(:,1:nl+1) = wghti1(:,1:nl+1)
+      t(:,1:nl+1) = t1(:,1:nl+1)
+      q(:,1:nl+1) = q1(:,1:nl+1)
+      qs(:,1:nl+1) = qs1(:,1:nl+1)
+      t_wake(:,1:nl+1) = t1_wake(:,1:nl+1)
+      q_wake(:,1:nl+1) = q1_wake(:,1:nl+1)
+      qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1)
+      u(:,1:nl+1) = u1(:,1:nl+1)
+      v(:,1:nl+1) = v1(:,1:nl+1)
+      gz(:,1:nl+1) = gz1(:,1:nl+1)
+      th(:,1:nl+1) = th1(:,1:nl+1)
+      th_wake(:,1:nl+1) = th1_wake(:,1:nl+1)
+      h(:,1:nl+1) = h1(:,1:nl+1)
+      lv(:,1:nl+1) = lv1(:,1:nl+1)
+      lf(:,1:nl+1) = lf1(:,1:nl+1)
+      cpn(:,1:nl+1) = cpn1(:,1:nl+1)
+      p(:,1:nl+1) = p1(:,1:nl+1)
+      ph(:,1:nl+1) = ph1(:,1:nl+1)
+      tv(:,1:nl+1) = tv1(:,1:nl+1)
+      tp(:,1:nl+1) = tp1(:,1:nl+1)
+      tvp(:,1:nl+1) = tvp1(:,1:nl+1)
+      clw(:,1:nl+1) = clw1(:,1:nl+1)
+      h_wake(:,1:nl+1) = h1_wake(:,1:nl+1)
+      lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1)
+      lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1)
+      cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1)
+      tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1)
+      sig(:,1:nl+1) = sig1(:,1:nl+1)
+      w0(:,1:nl+1) = w01(:,1:nl+1)
+      omega(:,1:nl+1) = omega1(:,1:nl+1)
+!
+      s_wake(:) = s1_wake(:)
+      iflag(:) = iflag1(:)
+      nk(:) = nk1(:)
+      icb(:) = icb1(:)
+      icbs(:) = icbs1(:)
+      plcl(:) = plcl1(:)
+      tnk(:) = tnk1(:)
+      qnk(:) = qnk1(:)
+      gznk(:) = gznk1(:)
+      hnk(:) = hnk1(:)
+      unk(:) = unk1(:)
+      vnk(:) = vnk1(:)
+      pbase(:) = pbase1(:)
+      buoybase(:) = buoybase1(:)
+      sig(:, nd) = sig1(:, nd)
+      ptop2(:) = ptop2(:)
+      Ale(:) = Ale1(:)
+      Alp(:) = Alp1(:)
+!
+  ENDIF !(compress)
+!>jyg
 
   RETURN