/[MITgcm]/MITgcm/pkg/profiles/profiles_init_ncfile.F
ViewVC logotype

Contents of /MITgcm/pkg/profiles/profiles_init_ncfile.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download)
Tue Aug 24 15:03:15 2010 UTC (13 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62k, checkpoint62j, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.7: +3 -3 lines
remove tabs

1 C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_init_ncfile.F,v 1.7 2007/10/09 00:07:59 jmc Exp $
2 C $Name: $
3
4 #include "PROFILES_OPTIONS.h"
5
6 C o==========================================================o
7 C | subroutine profiles_init_ncfile |
8 C | o initialization of model counterparts files |
9 C | for netcdf profiles data |
10 C | started: Gael Forget 15-March-2006 |
11 C o==========================================================o
12
13 subroutine profiles_init_ncfile(num_file,fid1,file2,fid2,length,
14 & Zlength,bi,bj,myThid)
15
16 implicit none
17
18 C ==================== Global Variables ===========================
19 #include "EEPARAMS.h"
20 #include "SIZE.h"
21 #include "GRID.h"
22 #include "DYNVARS.h"
23 #ifdef ALLOW_PROFILES
24 # include "profiles.h"
25 # include "netcdf.inc"
26 #endif
27 C ==================== Routine Variables ==========================
28 integer fid1,fid2,dimid1,dimid2,varid(10),varid0
29 integer myThid,bi,bj,err,vecid(2), length, Zlength
30 character*(80) file1, file2
31 integer irec, num_var,num_file
32 real*8 tmp_vec(Zlength+1)
33 c == end of interface ==
34
35 #ifdef ALLOW_PROFILES
36
37 if (profilesfile_equi_type.EQ.1) then
38 c1) creation :
39 err = NF_CREATE(file2 , NF_CLOBBER, fid2)
40 err = NF_DEF_DIM(fid2,'iDEPTH', Zlength ,dimid1)
41 err = NF_DEF_DIM(fid2,'iPROF',length,dimid2)
42 vecid(1)=dimid1
43 vecid(2)=dimid2
44
45 err = NF_DEF_VAR (fid2,'prof_ind_glob', NF_INT, 1,vecid(2),
46 & varid(1))
47 err = NF_PUT_ATT_INT(fid2,varid(1),'_FillValue',NF_INT,1,0)
48
49 do num_var=1,NVARMAX
50 err = NF_INQ_VARID(fid1,prof_names(num_var), varid0 )
51 if (err.EQ.NF_NOERR) then
52
53 err = NF_DEF_VAR (fid2,prof_names(num_var), NF_DOUBLE,
54 & 2,vecid,varid(2+(num_var-1)*2))
55 err = NF_PUT_ATT_DOUBLE(fid2, varid(2+(num_var-1)*2),'_FillValue',
56 & NF_DOUBLE,1, 0. _d 0 )
57 err = NF_DEF_VAR (fid2,prof_namesmask(num_var),
58 & NF_DOUBLE, 2,vecid, varid(3+(num_var-1)*2))
59 err = NF_PUT_ATT_DOUBLE(fid2,varid(3+(num_var-1)*2),'_FillValue',
60 & NF_DOUBLE,1, 0. _d 0)
61
62 endif
63 enddo
64
65 err=NF_ENDDEF(fid2)
66 err=NF_CLOSE(fid2)
67
68 err = NF_OPEN(file2, NF_WRITE , fid2)
69
70 else
71
72 call MDSFINDUNIT( fid2 , mythid )
73 open( fid2, file=file2, form ='unformatted', status='unknown',
74 & access='direct', recl= (Zlength + 1)*WORDLENGTH*2 )
75
76 do irec=1,Zlength+1
77 tmp_vec(irec)=0
78 enddo
79 #ifdef _BYTESWAPIO
80 call MDS_BYTESWAPR8(Zlength+1,tmp_vec)
81 #endif
82 do irec=length,1,-1
83 do num_var=prof_num_var_tot(num_file,bi,bj),1,-1
84 write(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
85 & +num_var-1)*2 +1) tmp_vec
86 write(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
87 & +num_var-1)*2 +2) tmp_vec
88 enddo
89 enddo
90
91 endif
92
93 #endif
94
95 END

  ViewVC Help
Powered by ViewVC 1.1.22