Changeset 1532 for trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90

Timestamp:

Apr 7, 2016, 3:53:15 PM (9 years ago)

Author:

emillour

Message:

Mars GCM:

• Some fixes for buggy outputs in 1D introduced by previous code modifications.
• made statto.h a module.
• ecritphy in dyn3d/control_mod.F90 should be an integer, not a real.

EM

File:

• trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90 (modified) (12 diffs)

trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90

@@ -36 +36 @@
 real*4,dimension(nbp_lon+1,nbp_lat) :: data2 ! to store 2D data
 real*4 :: data0 ! to store 0D data
+real*4 :: data3_1d(1,nsoilmx) ! to store a profile in 1D model
+real*4 :: data2_1d ! to store surface value with 1D model
 integer :: i,j,l ! for loops
 integer :: ig0
@@ -51 +53 @@
 character(len=20),save :: firstname="1234567890"
 integer,save :: zitau=0
+!$OMP THREADPRIVATE(date,isample,ntime,firstname,zitau)
 
 character(len=30) :: filename="diagsoil.nc"
@@ -107 +110 @@
 
    ! build inertia() and area()
-   do i=1,nbp_lon+1 ! poles
+   if (klon_glo>1) then
+    do i=1,nbp_lon+1 ! poles
      inertia(i,1,1:nsoilmx)=inertiafi_glo(1,1:nsoilmx)
      inertia(i,nbp_lat,1:nsoilmx)=inertiafi_glo(klon_glo,1:nsoilmx)
@@ -113 +117 @@
      area(i,1)=areafi_glo(1)/nbp_lon
      area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
-   enddo
-   do j=2,nbp_lat-1
+    enddo
+    do j=2,nbp_lat-1
      ig0= 1+(j-2)*nbp_lon
      do i=1,nbp_lon
@@ -123 +127 @@
      inertia(nbp_lon+1,j,1:nsoilmx)=inertia(1,j,1:nsoilmx)
      area(nbp_lon+1,j)=area(1,j)
-   enddo
+    enddo
+   endif
    
    ! write "header" of file (longitudes, latitudes, geopotential, ...)
-   call iniwritesoil(nid,ngrid,inertia,area)
+   if (klon_glo>1) then ! general 3D case
+     call iniwritesoil(nid,ngrid,inertia,area,nbp_lon+1,nbp_lat)
+   else ! 1D model
+     call iniwritesoil(nid,ngrid,inertiafi_glo(1,:),areafi_glo(1),1,1)
+   endif
 
   endif ! of if (is_master)
@@ -188 +197 @@
 !$OMP BARRIER
 #else
-  do l=1,nsoilmx
+  if (klon_glo>1) then ! General case
+   do l=1,nsoilmx
     ! handle the poles
     do i=1,nbp_lon+1
@@ -202 +212 @@
       data3(nbp_lon+1,j,l)=data3(1,j,l) ! extra (modulo) longitude
     enddo
-  enddo
+   enddo
+  else ! 1D model case
+   data3_1d(1,1:nsoilmx)=px(1,1:nsoilmx)
+  endif
 #endif
   
@@ -229 +242 @@
   corners(4)=ntime
   
-  edges(1)=nbp_lon+1
+  if (klon_glo==1) then
+    edges(1)=1
+  else
+    edges(1)=nbp_lon+1
+  endif
   edges(2)=nbp_lat
   edges(3)=nsoilmx
@@ -238 +255 @@
 !  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
 !#else
-  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+  if (klon_glo>1) then
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+  else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3_1d)
+  endif
 !#endif
   if (ierr.ne.NF_NOERR) then
@@ -263 +284 @@
 !$OMP BARRIER
 #else
-  ! handle the poles
-  do i=1,nbp_lon+1
-    data2(i,1)=px(1,1)
-    data2(i,nbp_lat)=px(ngrid,1)
-  enddo
-  ! rest of the grid
-  do j=2,nbp_lat-1
-    ig0=1+(j-2)*nbp_lon
-    do i=1,nbp_lon
-      data2(i,j)=px(ig0+i,1)
-    enddo
-    data2(nbp_lon+1,j)=data2(1,j) ! extra (modulo) longitude
-  enddo
+  if (klon_glo>1) then ! general case
+    ! handle the poles
+    do i=1,nbp_lon+1
+      data2(i,1)=px(1,1)
+      data2(i,nbp_lat)=px(ngrid,1)
+    enddo
+    ! rest of the grid
+    do j=2,nbp_lat-1
+      ig0=1+(j-2)*nbp_lon
+      do i=1,nbp_lon
+        data2(i,j)=px(ig0+i,1)
+      enddo
+      data2(nbp_lon+1,j)=data2(1,j) ! extra (modulo) longitude
+    enddo
+  else ! 1D model case
+    data2_1d=px(1,1)
+  endif
 #endif
 
@@ -300 +325 @@
   corners(3)=ntime
   
-  edges(1)=nbp_lon+1
+  if (klon_glo==1) then
+    edges(1)=1
+  else
+    edges(1)=nbp_lon+1
+  endif
   edges(2)=nbp_lat
   edges(3)=1
@@ -308 +337 @@
 !  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
 !#else
-  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+  if (klon_glo>1) then ! General case
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+  else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2_1d)
+  endif
 !#endif
   if (ierr.ne.NF_NOERR) then