/[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.3 - (show annotations) (download)
Sat May 6 15:14:01 2006 UTC (18 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58h_post, checkpoint58j_post, checkpoint58f_post, checkpoint58i_post, checkpoint58g_post, checkpoint58k_post
Changes since 1.2: +2 -2 lines
One more round of packaging.

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

  ViewVC Help
Powered by ViewVC 1.1.22