pkg/profiles/profiles_init_ncfile.F

24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
6a770e0a24 Patr*0002
                0003 C     o==========================================================o
                0004 C     | subroutine profiles_init_ncfile                          |
98bf704dd5 Jean*0005 C     | o initialization of model counterparts files             |
                0006 C     |   for netcdf profiles data                               |
6a770e0a24 Patr*0007 C     | started: Gael Forget 15-March-2006                       |
                0008 C     o==========================================================o
                0009
                0010       subroutine profiles_init_ncfile(num_file,fid1,file2,fid2,length,
71a5587721 Gael*0011      & Zlength,bi,bj,myThid)
6a770e0a24 Patr*0012
                0013       implicit none
                0014
                0015 C ==================== Global Variables ===========================
                0016 #include "EEPARAMS.h"
                0017 #include "SIZE.h"
                0018 #include "GRID.h"
                0019 #include "DYNVARS.h"
d28c90138c Patr*0020 #ifdef ALLOW_PROFILES
6328b73337 Gael*0021 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0022 # include "profiles.h"
                0023 # include "netcdf.inc"
                0024 #endif
6a770e0a24 Patr*0025 C ==================== Routine Variables ==========================
                0026       integer fid1,fid2,dimid1,dimid2,varid(10),varid0
71a5587721 Gael*0027       integer myThid,bi,bj,err,vecid(2), length, Zlength
de57a2ec4b Mart*0028       character*(MAX_LEN_FNAM) file2
6a770e0a24 Patr*0029       integer irec, num_var,num_file
                0030       real*8 tmp_vec(Zlength+1)
                0031 c     == end of interface ==
                0032
d28c90138c Patr*0033 #ifdef ALLOW_PROFILES
6e4c90fea3 Patr*0034
f0e4bffe35 Gael*0035       if (profilesDoNcOutput) then
6a770e0a24 Patr*0036 c1) creation :
                0037       err = NF_CREATE(file2 , NF_CLOBBER, fid2)
                0038       err = NF_DEF_DIM(fid2,'iDEPTH', Zlength ,dimid1)
                0039       err = NF_DEF_DIM(fid2,'iPROF',length,dimid2)
                0040       vecid(1)=dimid1
                0041       vecid(2)=dimid2
                0042
                0043       err = NF_DEF_VAR (fid2,'prof_ind_glob', NF_INT, 1,vecid(2),
                0044      & varid(1))
                0045       err = NF_PUT_ATT_INT(fid2,varid(1),'_FillValue',NF_INT,1,0)
                0046
ea4d09597a Gael*0047       do num_var=1,NVARMAX
cf16ba6028 Gael*0048       err = NF_INQ_VARID(fid1,prof_names(num_file,num_var), varid0 )
6a770e0a24 Patr*0049       if (err.EQ.NF_NOERR) then
                0050
cf16ba6028 Gael*0051       err = NF_DEF_VAR (fid2,prof_names(num_file,num_var), NF_DOUBLE,
ef53b829d7 Jean*0052      & 2,vecid,varid(2+(num_var-1)*2))
6a770e0a24 Patr*0053       err = NF_PUT_ATT_DOUBLE(fid2, varid(2+(num_var-1)*2),'_FillValue',
ef53b829d7 Jean*0054      & NF_DOUBLE,1, 0. _d 0 )
cf16ba6028 Gael*0055       err = NF_DEF_VAR (fid2,prof_namesmask(num_file,num_var),
6a770e0a24 Patr*0056      & NF_DOUBLE, 2,vecid, varid(3+(num_var-1)*2))
                0057       err = NF_PUT_ATT_DOUBLE(fid2,varid(3+(num_var-1)*2),'_FillValue',
                0058      & NF_DOUBLE,1, 0. _d 0)
                0059
                0060       endif
ef53b829d7 Jean*0061       enddo
6a770e0a24 Patr*0062
                0063       err=NF_ENDDEF(fid2)
                0064       err=NF_CLOSE(fid2)
                0065
                0066       err = NF_OPEN(file2, NF_WRITE , fid2)
                0067
                0068       else
                0069
5042c05de8 Gael*0070 c      call MDSFINDUNIT( fid2 , mythid )
6a770e0a24 Patr*0071        open( fid2, file=file2, form ='unformatted', status='unknown',
                0072      &      access='direct', recl=  (Zlength + 1)*WORDLENGTH*2 )
                0073
                0074        do irec=1,Zlength+1
                0075        tmp_vec(irec)=0
                0076        enddo
                0077 #ifdef _BYTESWAPIO
                0078             call MDS_BYTESWAPR8(Zlength+1,tmp_vec)
ef53b829d7 Jean*0079 #endif
6a770e0a24 Patr*0080        do irec=length,1,-1
71a5587721 Gael*0081        do num_var=prof_num_var_tot(num_file,bi,bj),1,-1
                0082        write(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
6a770e0a24 Patr*0083      & +num_var-1)*2 +1) tmp_vec
71a5587721 Gael*0084        write(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
6a770e0a24 Patr*0085      & +num_var-1)*2 +2) tmp_vec
                0086        enddo
                0087        enddo
                0088
                0089        endif
                0090
6e4c90fea3 Patr*0091 #endif
                0092
6a770e0a24 Patr*0093       END