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.
obs_utils.F90 in branches/dev_1784_OBS/NEMO/OPA_SRC/OBS – NEMO

source: branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_utils.F90 @ 2001

Last change on this file since 2001 was 2001, checked in by djlea, 14 years ago

Adding observation operator code
File size: 6.9 KB
Line 
1MODULE obs_utils
2   !!======================================================================
3   !!                       ***  MODULE obs_utils   ***
4   !! Observation diagnostics: Utility functions
5   !!=====================================================================
6
7   !!----------------------------------------------------------------------
8   !!   grt_cir_dis     : Great circle distance
9   !!   grt_cir_dis_saa : Great circle distance (small angle)
10   !!   chkerr          : Error-message managment for NetCDF files
11   !!   chkdim          : Error-message managment for NetCDF files
12   !!   fatal_error     : Fatal error handling
13   !!   ddatetoymdhms   : Convert YYYYMMDD.hhmmss to components
14   !!----------------------------------------------------------------------
15   !! * Modules used
16   USE par_oce, ONLY : &        ! Precision variables
17      & wp, &
18      & dp, &
19      & i8 
20   USE in_out_manager           ! I/O manager
21 
22   IMPLICIT NONE
23
24   !! * Routine accessibility
25   PRIVATE
26   PUBLIC grt_cir_dis,     &  ! Great circle distance
27      &   grt_cir_dis_saa, &  ! Great circle distance (small angle)
28      &   str_c_to_for,    &  ! Remove non-printable chars from string
29      &   chkerr,          &  ! Error-message managment for NetCDF files
30      &   chkdim,          &  ! Check if dimensions are correct for a variable
31      &   fatal_error,     &  ! Fatal error handling
32      &   warning,         &  ! Warning handling
33      &   ddatetoymdhms       ! Convert YYYYMMDD.hhmmss to components
34         
35CONTAINS
36 
37#include "grt_cir_dis.h90"
38
39#include "grt_cir_dis_saa.h90"
40
41#include "str_c_to_for.h90"
42
43   SUBROUTINE chkerr( kstatus, cd_name, klineno )
44      !!----------------------------------------------------------------------
45      !!   
46      !!                    *** ROUTINE chkerr ***
47      !!
48      !! ** Purpose : Error-message managment for NetCDF files.
49      !!
50      !! ** Method  :
51      !!
52      !! ** Action  :
53      !!
54      !! History
55      !!      ! 02-12  (N. Daget)  hdlerr
56      !!      ! 06-04  (A. Vidard) f90/nemovar migration, change name
57      !!      ! 06-10  (A. Weaver) Cleanup
58      !!----------------------------------------------------------------------
59      !! * Modules used
60      USE netcdf             ! NetCDF library
61      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
62         & nproc
63
64      !! * Arguments
65      INTEGER :: &
66         & kstatus, &
67         & klineno
68      CHARACTER(LEN=*) :: &
69         & cd_name
70     
71      !! * Local declarations
72      CHARACTER(len=200) :: &
73         & clineno
74
75      ! Main computation
76      IF ( kstatus /= nf90_noerr ) THEN
77         WRITE(clineno,'(A,I8)')' at line number ', klineno
78         CALL ctl_stop( ' chkerr', ' Netcdf Error in ' // TRIM( cd_name ), &
79            &           clineno, nf90_strerror( kstatus ) )
80      ENDIF
81
82   END SUBROUTINE chkerr
83
84   SUBROUTINE chkdim( kfileid, kvarid, kndim, kdim, cd_name, klineno )
85      !!----------------------------------------------------------------------
86      !!   
87      !!                    *** ROUTINE chkerr ***
88      !!
89      !! ** Purpose : Error-message managment for NetCDF files.
90      !!
91      !! ** Method  :
92      !!
93      !! ** Action  :
94      !!
95      !! History
96      !!      ! 07-03  (K. Mogenen + E. Remy) Initial version
97      !!----------------------------------------------------------------------
98      !! * Modules used
99      USE netcdf             ! NetCDF library
100      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
101         & nproc
102
103      !! * Arguments
104      INTEGER :: &
105         & kfileid, &    ! NetCDF file id   
106         & kvarid,  &    ! NetCDF variable id   
107         & kndim         ! Expected number of dimensions
108      INTEGER, DIMENSION(kndim) :: &
109         & kdim          ! Expected dimensions
110      CHARACTER(LEN=*) :: &
111         & cd_name       ! Calling routine name
112      INTEGER :: &
113         & klineno       ! Calling line number
114
115      !! * Local declarations
116      INTEGER :: &
117         & indim
118      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
119         & idim,ilendim
120      INTEGER :: &
121         & ji
122      LOGICAL :: &
123         & llerr
124      CHARACTER(len=200) :: &
125         & clineno
126
127
128      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), &
129         &         cd_name, klineno )
130
131      ALLOCATE(idim(indim),ilendim(indim))
132
133      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, dimids=idim ), &
134         &         cd_name, klineno )
135
136      DO ji = 1, indim
137         CALL chkerr( nf90_inquire_dimension( kfileid, idim(ji), &
138            &                                 len=ilendim(ji) ), &
139            &         cd_name, klineno )
140      END DO
141     
142      IF ( indim /= kndim ) THEN
143         WRITE(clineno,'(A,I8)')' at line number ', klineno
144         CALL ctl_stop( ' chkdim',  &
145            &           ' Netcdf no dim error in ' // TRIM( cd_name ), &
146            &           clineno )
147      ENDIF
148
149      DO ji = 1, indim
150         IF ( ilendim(ji) /= kdim(ji) ) THEN
151            WRITE(clineno,'(A,I8)')' at line number ', klineno
152            CALL ctl_stop( ' chkdim',  &
153               &           ' Netcdf dim len error in ' // TRIM( cd_name ), &
154               &           clineno )
155         ENDIF
156      END DO
157         
158      DEALLOCATE(idim,ilendim)
159
160   END SUBROUTINE chkdim
161   
162  SUBROUTINE fatal_error( cd_name, klineno )
163      !!----------------------------------------------------------------------
164      !!
165      !!                    *** ROUTINE fatal_error ***
166      !!
167      !! ** Purpose : Fatal error handling
168      !!
169      !! ** Method  :
170      !!
171      !! ** Action  :
172      !!
173      !! History
174      !!----------------------------------------------------------------------
175      !! * Modules used
176
177      !! * Arguments
178      INTEGER :: &
179         & klineno
180      CHARACTER(LEN=*) :: &
181         & cd_name
182      !! * Local declarations
183      CHARACTER(len=200) :: &
184         & clineno
185
186      WRITE(clineno,'(A,I8)')' at line number ', klineno
187      CALL ctl_stop( ' fatal_error', ' Error in ' // TRIM( cd_name ), &
188         &           clineno)
189     
190   END SUBROUTINE fatal_error
191
192   SUBROUTINE warning( cd_name, klineno )
193      !!----------------------------------------------------------------------
194      !!
195      !!                    *** ROUTINE warning ***
196      !!
197      !! ** Purpose : Warning handling
198      !!
199      !! ** Method  :
200      !!
201      !! ** Action  :
202      !!
203      !! History
204      !!----------------------------------------------------------------------
205      !! * Modules used
206
207      !! * Arguments
208      INTEGER :: &
209         & klineno
210      CHARACTER(LEN=*) :: &
211         & cd_name
212      !! * Local declarations
213      CHARACTER(len=200) :: &
214         & clineno
215
216      WRITE(clineno,'(A,I8)')' at line number ', klineno
217      CALL ctl_warn( ' warning', ' Potential problem in ' // TRIM( cd_name ), &
218         &           clineno)
219     
220   END SUBROUTINE warning
221
222#include "ddatetoymdhms.h90"
223
224END MODULE obs_utils
Note: See TracBrowser for help on using the repository browser.