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/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90 @ 5715

Last change on this file since 5715 was 5715, checked in by acc, 9 years ago

Branch NERC/dev_r5107_NOC_MEDUSA. Complete reset of svn keyword properties in a desperate attempt to make fcm_make behave.

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