Changeset 204 for LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F

Timestamp:

Apr 13, 2001, 12:44:53 PM (23 years ago)

Author:

lmdz

Message:

Debogage du guidage et de la version debranchee et abandon de la version
debranchee non-netcdf FH/MAF
LF

File:

• LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F (modified) (11 diffs)

LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F

@@ +1 @@
+c
 c $Header
+c
+
       PROGRAM create_fausse_var
 C
@@ -9 +12 @@
 #include "comconst.h"
 #include "comgeom.h"
+#include "comvert.h"
+
+      real temp(iim+1,jjm+1)
 #include "netcdf.inc"
 
@@ -19 +25 @@
         integer*4 out_latudim,out_latvdim,out_dim(3)
 
-c   champs a faire disparaitre
-        real ucov(ijp1llm),vcov(ijmllm),teta(ijp1llm)
-        real masse(ijp1llm),ps(ip1jmp1),phis(ip1jmp1)
-        real q(ijp1llm*nqmx)
-        real time_0
-
-        real clesphy0(20),pa,preff
+      INTEGER         longcles
+      PARAMETER     ( longcles = 20 )
+      REAL  clesphy0( longcles )
+
+      integer start(4),count(4)
 
         integer status,i,j
@@ -31 +35 @@
         real rlonudeg(iip1),rlonvdeg(iip1)
 
+      real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
+      real acoslat,dxkm,dykm,resol(iip1,jjp1)
+
+#include "serre.h"
+#include "fxyprim.h"
+
+      print*,'OK0'
 
       rad = 6400000
@@ -42 +53 @@
       pa= 50000.
 
-c     CALL dynetat0("start.nc",nqmx,vcov,ucov,
-c    .              teta,q,masse,ps,phis, time_0)
-
-
       open(99,file='run.def',status='old',form='formatted')
-      CALL defrun_new( 99, .TRUE. ,clesphy0)
+      CALL defrun_new( 99, .TRUE.,clesphy0 )
       close(99)
       CALL iniconst
-      print*,'inigeom pas OK'
       CALL inigeom
-      print*,'inigeom OK'
-
+
+
+      print*,'OK1'
       do j=1,jjp1
          rlatudeg(j)=rlatu(j)*180./pi
@@ -66 +73 @@
       enddo
 
-      print*,'  2 ----- OUVERTURE DE LA SORTIE NETCDF'
+
+      print*,'OK2'
+c  2 ----- OUVERTURE DE LA SORTIE NETCDF
 c ---------------------------------------------------
 c CREATION OUTPUT
@@ -78 +87 @@
         status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
 
+
+      print*,'OK3'
 c   Longitudes en u
         print *,'OUTID: ',ncid_out
@@ -138 +149 @@
      %  16,'Grille aux point v')
 
-
+c   ecriture de la grille u
+        out_dim(1)=out_lonvdim
+        out_dim(2)=out_latudim
+        status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim,
+     %  out_varid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
+     %  6,'Kelvin')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
+     %  16,'Grille aux point u')
+
+
+      print*,'OK4'
         status=NF_ENDDEF(ncid_out)
-        print*,' 5) ----- FERMETURE DES FICHIERS NETCDF-'
+c 5) ----- FERMETURE DES FICHIERS NETCDF------------------
 c --------------------------------------------------------
 c 3-b- Ecriture de la grille pour la sortie
@@ -150 +173 @@
         status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
 
+        start(1)=1
+        start(2)=1
+        start(3)=1
+        start(4)=1
+
+        count(1)=iim+1
+        count(2)=jjm+1
+        count(3)=1
+        count(4)=1
+
+        do j=1,jjm+1
+           do i=1,iim+1
+              temp(i,j)=mod(i,2)+mod(j,2)
+           enddo
+        enddo
+
+        status=NF_PUT_VARA_REAL(ncid_out,out_varid,start,
+     s  count,temp)
 
 c fermeture du fichier netcdf
@@ -155 +196 @@
         write(*,*) 'Fermeture: ',fich_out
 
+
+      print*,'OK5'
+c   Ecriture grads
+      open (20,file='grille.dat',form='unformatted',access='direct'
+     s      ,recl=4*ip1jmp1)
+      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
+      do j=2,jjm
+         dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
+c        dlat2(j)=180.*fyprim(float(j))/pi
+      enddo
+      do i=2,iip1
+         dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
+c        dlon2(i)=180.*fxprim(float(i))/pi
+      enddo
+      do j=2,jjm
+         dykm=(rlatv(j)-rlatv(j-1))*6400.
+         acoslat=6400.*cos(rlatu(j))
+         do i=2,iip1
+            dxkm=acoslat*(rlonu(i)-rlonu(i-1))
+            resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm)
+         enddo
+         resol(1,j)=resol(iip1,j)
+      enddo
+      write(20,rec=3) resol
+      dlon1(1)=dlon1(iip1)
+      dlon2(1)=dlon2(iip1)
+      write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1)
+      write(20,rec=5) ((dlon2(i),i=1,iip1),j=1,jjp1)
+      write(20,rec=6) ((dlat1(j),i=1,iip1),j=1,jjp1)
+      write(20,rec=7) ((dlat2(j),i=1,iip1),j=1,jjp1)
+        
+      open (21,file='grille.ctl',form='formatted')
+
+c   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      write(21,'(a5,1x,a40)')
+     &       'DSET ','^grille.dat'
+
+      write(21,'(a12)') 'UNDEF 1.0E30'
+      write(21,'(a5,1x,a40)') 'TITLE ','grille'
+      call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF')
+      call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF')
+      call formcoord(21,1,0.,1.,.false.,'ZDEF')
+      write(21,'(a4,i10,a30)')
+     &       'TDEF ',1,' LINEAR 23OCT1994 3hr '
+      write(21,'(a4,2x,i5)') 'VARS',7
+      write(21,'(a18)') 'grille 0 99 grille'
+      write(21,'(a18)') 'gril   0 99 gril  '
+      write(21,'(a29)') 'resol   0 99 resolution (km)  '
+      write(21,'(a18)') 'dlon1  0 99 dlon1 '
+      write(21,'(a18)') 'dlon2  0 99 dlon2 '
+      write(21,'(a18)') 'dlat1  0 99 dlat1 '
+      write(21,'(a18)') 'dlat2  0 99 dlat2 '
+      write(21,'(a7)') 'ENDVARS'
+
+
+
+
+
+      print*,'OK6'
         end
 
@@ -161 +262 @@
         subroutine handle_err(status)
 #include "netcdf.inc"
+
+
         integer status
         print *,'handle code err: ',NF_NOERR