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 NEMO/trunk/src/OCE/OBS – NEMO

source: NEMO/trunk/src/OCE/OBS/obs_utils.F90

Last change on this file was 14275, checked in by smasson, 20 months ago

trunk: suppress nproc ( = mpprank = narea-1)

  • Property svn:keywords set to Id
File size: 6.8 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/OCE 4.0 , NEMO Consortium (2018)
38   !! $Id$
39   !! Software governed by the CeCILL license (see ./LICENSE)
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
69      !! * Arguments
70      INTEGER :: kstatus
71      INTEGER :: klineno
72      CHARACTER(LEN=*) :: cd_name
73     
74      !! * Local declarations
75      CHARACTER(len=200) :: clineno
76
77      ! Main computation
78      IF ( kstatus /= nf90_noerr ) THEN
79         WRITE(clineno,'(A,I8)')' at line number ', klineno
80         CALL ctl_stop( ' chkerr', ' Netcdf Error in ' // TRIM( cd_name ), &
81            &           clineno, nf90_strerror( kstatus ) )
82      ENDIF
83
84   END SUBROUTINE chkerr
85
86   SUBROUTINE chkdim( kfileid, kvarid, kndim, kdim, cd_name, klineno )
87      !!----------------------------------------------------------------------
88      !!   
89      !!                    *** ROUTINE chkerr ***
90      !!
91      !! ** Purpose : Error-message managment for NetCDF files.
92      !!
93      !! ** Method  :
94      !!
95      !! ** Action  :
96      !!
97      !! History
98      !!      ! 07-03  (K. Mogenen + E. Remy) Initial version
99      !!----------------------------------------------------------------------
100      !! * Modules used
101      USE netcdf             ! NetCDF library
102
103      !! * Arguments
104      INTEGER :: kfileid       ! NetCDF file id   
105      INTEGER :: kvarid        ! NetCDF variable id   
106      INTEGER :: kndim         ! Expected number of dimensions
107      INTEGER, DIMENSION(kndim) :: kdim      ! Expected dimensions
108      CHARACTER(LEN=*) :: cd_name            ! Calling routine name
109      INTEGER ::  klineno      ! Calling line number
110
111      !! * Local declarations
112      INTEGER :: indim
113      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
114         & idim,ilendim
115      INTEGER :: ji
116      LOGICAL :: llerr
117      CHARACTER(len=200) :: clineno
118
119      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), &
120         &         cd_name, klineno )
121
122      ALLOCATE(idim(indim),ilendim(indim))
123
124      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, dimids=idim ), &
125         &         cd_name, klineno )
126
127      DO ji = 1, indim
128         CALL chkerr( nf90_inquire_dimension( kfileid, idim(ji), &
129            &                                 len=ilendim(ji) ), &
130            &         cd_name, klineno )
131      END DO
132     
133      IF ( indim /= kndim ) THEN
134         WRITE(clineno,'(A,I8)')' at line number ', klineno
135         CALL ctl_stop( ' chkdim',  &
136            &           ' Netcdf no dim error in ' // TRIM( cd_name ), &
137            &           clineno )
138      ENDIF
139
140      DO ji = 1, indim
141         IF ( ilendim(ji) /= kdim(ji) ) THEN
142            WRITE(clineno,'(A,I8)')' at line number ', klineno
143            CALL ctl_stop( ' chkdim',  &
144               &           ' Netcdf dim len error in ' // TRIM( cd_name ), &
145               &           clineno )
146         ENDIF
147      END DO
148         
149      DEALLOCATE(idim,ilendim)
150
151   END SUBROUTINE chkdim
152   
153  SUBROUTINE fatal_error( cd_name, klineno )
154      !!----------------------------------------------------------------------
155      !!
156      !!                    *** ROUTINE fatal_error ***
157      !!
158      !! ** Purpose : Fatal error handling
159      !!
160      !! ** Method  :
161      !!
162      !! ** Action  :
163      !!
164      !! History
165      !!----------------------------------------------------------------------
166      !! * Modules used
167
168      !! * Arguments
169      INTEGER :: klineno
170      CHARACTER(LEN=*) :: cd_name
171      !! * Local declarations
172      CHARACTER(len=200) :: clineno
173
174      WRITE(clineno,'(A,I8)')' at line number ', klineno
175      CALL ctl_stop( ' fatal_error', ' Error in ' // TRIM( cd_name ), &
176         &           clineno)
177     
178   END SUBROUTINE fatal_error
179
180   SUBROUTINE warning( cd_name, klineno )
181      !!----------------------------------------------------------------------
182      !!
183      !!                    *** ROUTINE warning ***
184      !!
185      !! ** Purpose : Warning handling
186      !!
187      !! ** Method  :
188      !!
189      !! ** Action  :
190      !!
191      !! History
192      !!----------------------------------------------------------------------
193      !! * Modules used
194
195      !! * Arguments
196      INTEGER :: klineno
197      CHARACTER(LEN=*) :: cd_name
198      !! * Local declarations
199      CHARACTER(len=200) :: clineno
200
201      WRITE(clineno,'(A,I8)')' at line number ', klineno
202      CALL ctl_warn( ' warning', ' Potential problem in ' // TRIM( cd_name ), &
203         &           clineno)
204     
205   END SUBROUTINE warning
206
207#include "ddatetoymdhms.h90"
208
209END MODULE obs_utils
Note: See TracBrowser for help on using the repository browser.