New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sao_read.F90 in trunk/NEMOGCM/NEMO/SAO_SRC – NEMO

source: trunk/NEMOGCM/NEMO/SAO_SRC/sao_read.F90 @ 7881

Last change on this file since 7881 was 7646, checked in by timgraham, 7 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File size: 6.7 KB
Line 
1MODULE sao_read
2   !!======================================================================
3   !!                      ***  MODULE sao_read  ***
4   !! Read routines : I/O for Stand Alone Observation operator
5   !!======================================================================
6   USE mppini
7   USE lib_mpp
8   USE in_out_manager
9   USE par_kind, ONLY: lc
10   USE netcdf
11   USE oce,     ONLY: tsn, sshn
12   USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask
13   USE par_oce, ONLY: jpi, jpj, jpk
14   !
15   USE obs_fbm, ONLY: fbimdi, fbrmdi, fbsp, fbdp
16   USE sao_data
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC sao_rea_dri
22
23   !!----------------------------------------------------------------------
24   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
25   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $
26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
27   !!----------------------------------------------------------------------
28CONTAINS
29
30   SUBROUTINE sao_rea_dri( kfile )
31      !!------------------------------------------------------------------------
32      !!             *** sao_rea_dri ***
33      !!
34      !! Purpose : To choose appropriate read method
35      !! Method  :
36      !!
37      !! Author  : A. Ryan Oct 2013
38      !!
39      !!------------------------------------------------------------------------
40      INTEGER, INTENT(in) ::   kfile         ! File number
41      !
42      CHARACTER(len=lc)   ::   cdfilename    ! File name
43      INTEGER ::   kindex        ! File index to read
44      !!------------------------------------------------------------------------
45      !
46      cdfilename = TRIM( sao_files(kfile) )
47      kindex = nn_sao_idx(kfile)
48      CALL sao_read_file( TRIM( cdfilename ), kindex )
49      !
50   END SUBROUTINE sao_rea_dri
51
52
53   SUBROUTINE sao_read_file( filename, ifcst )
54      !!------------------------------------------------------------------------
55      !!                         ***  sao_read_file  ***
56      !!
57      !! Purpose : To fill tn and sn with dailymean field from netcdf files
58      !! Method  : Use subdomain indices to create start and count matrices
59      !!           for netcdf read.
60      !!
61      !! Author  : A. Ryan Oct 2010
62      !!------------------------------------------------------------------------
63      INTEGER,          INTENT(in) ::   ifcst
64      CHARACTER(len=*), INTENT(in) ::   filename
65      INTEGER                      ::   ncid, varid, istat, ntimes
66      INTEGER                      ::   tdim, xdim, ydim, zdim
67      INTEGER                      ::   ii, ij, ik
68      INTEGER, DIMENSION(4)        ::   start_n, count_n
69      INTEGER, DIMENSION(3)        ::   start_s, count_s
70      REAL(fbdp)                   ::   fill_val
71      REAL(fbdp), DIMENSION(:,:,:), ALLOCATABLE ::   temp_tn, temp_sn
72      REAL(fbdp), DIMENSION(:,:)  , ALLOCATABLE ::   temp_sshn
73
74      ! DEBUG
75      INTEGER ::   istage
76      !!------------------------------------------------------------------------
77
78      IF (TRIM(filename) == 'nofile') THEN
79         tsn (:,:,:,:) = fbrmdi
80         sshn(:,:)     = fbrmdi
81      ELSE
82         WRITE(numout,*) "Opening :", TRIM(filename)
83         ! Open Netcdf file to find dimension id
84         istat = nf90_open(path=TRIM(filename), mode=nf90_nowrite, ncid=ncid)
85         IF ( istat /= nf90_noerr ) THEN
86             WRITE(numout,*) "WARNING: Could not open ", trim(filename)
87             WRITE(numout,*) "ERROR: ", nf90_strerror(istat)
88         ENDIF
89         istat = nf90_inq_dimid(ncid,'x',xdim)
90         istat = nf90_inq_dimid(ncid,'y',ydim)
91         istat = nf90_inq_dimid(ncid,'deptht',zdim)
92         istat = nf90_inq_dimid(ncid,'time_counter',tdim)
93         istat = nf90_inquire_dimension(ncid, tdim, len=ntimes)
94         IF (ifcst .LE. ntimes) THEN
95            ! Allocate temporary temperature array
96            ALLOCATE(temp_tn(nlci,nlcj,jpk))
97            ALLOCATE(temp_sn(nlci,nlcj,jpk))
98            ALLOCATE(temp_sshn(nlci,nlcj))
99
100            ! Set temp_tn, temp_sn to 0.
101            temp_tn(:,:,:) = fbrmdi
102            temp_sn(:,:,:) = fbrmdi
103            temp_sshn(:,:) = fbrmdi
104
105            ! Create start and count arrays
106            start_n = (/ nimpp, njmpp, 1,   ifcst /)
107            count_n = (/ nlci,  nlcj,  jpk, 1     /)
108            start_s = (/ nimpp, njmpp, ifcst /)
109            count_s = (/ nlci,  nlcj,  1     /)
110
111            ! Read information into temporary arrays
112            ! retrieve varid and read in temperature
113            istat = nf90_inq_varid(ncid,'votemper',varid)
114            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
115            istat = nf90_get_var(ncid, varid, temp_tn, start_n, count_n)
116            WHERE(temp_tn(:,:,:) == fill_val) temp_tn(:,:,:) = fbrmdi
117
118            ! retrieve varid and read in salinity
119            istat = nf90_inq_varid(ncid,'vosaline',varid)
120            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
121            istat = nf90_get_var(ncid, varid, temp_sn, start_n, count_n)
122            WHERE(temp_sn(:,:,:) == fill_val) temp_sn(:,:,:) = fbrmdi
123
124            ! retrieve varid and read in SSH
125            istat = nf90_inq_varid(ncid,'sossheig',varid)
126            IF (istat /= nf90_noerr) THEN
127               ! Altimeter bias
128               istat = nf90_inq_varid(ncid,'altbias',varid)
129            END IF
130
131            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
132            istat = nf90_get_var(ncid, varid, temp_sshn, start_s, count_s)
133            WHERE(temp_sshn(:,:) == fill_val) temp_sshn(:,:) = fbrmdi
134
135            ! Initialise tsn, sshn to fbrmdi
136            tsn(:,:,:,:) = fbrmdi
137            sshn(:,:) = fbrmdi
138
139            ! Mask out missing data index
140            tsn(1:nlci,1:nlcj,1:jpk,1) = temp_tn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
141            tsn(1:nlci,1:nlcj,1:jpk,2) = temp_sn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
142            sshn(1:nlci,1:nlcj)        = temp_sshn(:,:) * tmask(1:nlci,1:nlcj,1)
143
144            ! Remove halo from tmask, tsn, sshn to prevent double obs counting
145            IF (jpi > nlci) THEN
146                tmask(nlci+1:,:,:) = 0
147                tsn(nlci+1:,:,:,1) = 0
148                tsn(nlci+1:,:,:,2) = 0
149                sshn(nlci+1:,:) = 0
150            END IF
151            IF (jpj > nlcj) THEN
152                tmask(:,nlcj+1:,:) = 0
153                tsn(:,nlcj+1:,:,1) = 0
154                tsn(:,nlcj+1:,:,2) = 0
155                sshn(:,nlcj+1:) = 0
156            END IF
157
158            ! Deallocate arrays
159            DEALLOCATE(temp_tn, temp_sn, temp_sshn)
160         ELSE
161            ! Mark all as missing data
162            tsn(:,:,:,:) = fbrmdi
163            sshn(:,:) = fbrmdi
164         ENDIF
165         ! Close netcdf file
166         WRITE(numout,*) "Closing :", TRIM(filename)
167         istat = nf90_close(ncid)
168      END IF
169      !
170   END SUBROUTINE sao_read_file
171   
172   !!------------------------------------------------------------------------
173END MODULE sao_read
Note: See TracBrowser for help on using the repository browser.