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.
lib_fortran.F90 in NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/lib_fortran.F90 @ 14286

Last change on this file since 14286 was 14286, checked in by mcastril, 3 years ago

Reformatting and allowing to use key_qco
  • Property svn:keywords set to Id
File size: 19.3 KB
Line 
1MODULE lib_fortran
2   !!======================================================================
3   !!                       ***  MODULE  lib_fortran  ***
4   !! Fortran utilities:  includes some low levels fortran functionality
5   !!======================================================================
6   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
7   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max
8   !!                                           + 3d dim. of input is fexible (jpk, jpl...)
9   !!            4.0  !  2016-06  (T. Lovato)  double precision global sum by default
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   glob_sum    : generic interface for global masked summation over
14   !!                 the interior domain for 1 or 2 2D or 3D arrays
15   !!                 it works only for T points
16   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
17   !!                 of intrinsinc sign function
18   !!----------------------------------------------------------------------
19   USE par_oce         ! Ocean parameter
20   USE dom_oce         ! ocean domain
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distributed memory computing
23   USE lbclnk          ! ocean lateral boundary conditions
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
29   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos)
30   PUBLIC   local_sum     ! used in trcrad, local operation before glob_sum_delay
31   PUBLIC   sum3x3        ! used in trcrad, do a sum over 3x3 boxes
32   PUBLIC   DDPDD         ! also used in closea module
33   PUBLIC   glob_min, glob_max
34#if defined key_nosignedzero
35   PUBLIC SIGN
36#endif
37
38   INTERFACE glob_sum
39      MODULE PROCEDURE glob_sum_1d_sp, glob_sum_2d_sp, glob_sum_3d_sp
40      MODULE PROCEDURE glob_sum_1d_dp, glob_sum_2d_dp, glob_sum_3d_dp
41   END INTERFACE
42   INTERFACE glob_sum_full
43      MODULE PROCEDURE glob_sum_full_2d_sp, glob_sum_full_3d_sp
44      MODULE PROCEDURE glob_sum_full_2d_dp, glob_sum_full_3d_dp
45   END INTERFACE
46   INTERFACE local_sum
47      MODULE PROCEDURE local_sum_2d, local_sum_3d
48   END INTERFACE
49   INTERFACE sum3x3
50      MODULE PROCEDURE sum3x3_2d, sum3x3_3d
51   END INTERFACE
52   INTERFACE glob_min
53      MODULE PROCEDURE glob_min_2d_sp, glob_min_3d_sp
54      MODULE PROCEDURE glob_min_2d_dp, glob_min_3d_dp
55   END INTERFACE
56   INTERFACE glob_max
57      MODULE PROCEDURE glob_max_2d_sp, glob_max_3d_sp
58      MODULE PROCEDURE glob_max_2d_dp, glob_max_3d_dp
59   END INTERFACE
60
61#if defined key_nosignedzero
62   INTERFACE SIGN
63      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
64         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          &
65         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B
66   END INTERFACE
67#endif
68
69   !! * Substitutions
70#  include "do_loop_substitute.h90"
71   !!----------------------------------------------------------------------
72   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
73   !! $Id$
74   !! Software governed by the CeCILL license (see ./LICENSE)
75   !!----------------------------------------------------------------------
76CONTAINS
77
78
79!                          ! FUNCTION global_sum !
80!                          ! single precision version !
81# define PRECISION sp
82# include "lib_fortran_globsum.h90"
83# undef PRECISION
84!                          ! double precision version !
85# define PRECISION dp
86# include "lib_fortran_globsum.h90"
87# undef PRECISION
88
89!                          ! FUNCTION local_sum !
90
91   FUNCTION local_sum_2d( ptab )
92      !!----------------------------------------------------------------------
93      REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied
94      COMPLEX(dp)              ::  local_sum_2d
95      !
96      !!-----------------------------------------------------------------------
97      !
98      COMPLEX(dp)::   ctmp
99      REAL(wp)   ::   ztmp
100      INTEGER    ::   ji, jj    ! dummy loop indices
101      INTEGER    ::   ipi, ipj  ! dimensions
102      !!-----------------------------------------------------------------------
103      !
104      ipi = SIZE(ptab,1)   ! 1st dimension
105      ipj = SIZE(ptab,2)   ! 2nd dimension
106      !
107      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
108
109      DO jj = 1, ipj
110         DO ji = 1, ipi
111            ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
112            CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
113         END DO
114      END DO
115      !
116      local_sum_2d = ctmp
117       
118   END FUNCTION local_sum_2d
119
120   FUNCTION local_sum_3d( ptab )
121      !!----------------------------------------------------------------------
122      REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied
123      COMPLEX(dp)              ::  local_sum_3d
124      !
125      !!-----------------------------------------------------------------------
126      !
127      COMPLEX(dp)::   ctmp
128      REAL(wp)   ::   ztmp
129      INTEGER    ::   ji, jj, jk   ! dummy loop indices
130      INTEGER    ::   ipi, ipj, ipk    ! dimensions
131      !!-----------------------------------------------------------------------
132      !
133      ipi = SIZE(ptab,1)   ! 1st dimension
134      ipj = SIZE(ptab,2)   ! 2nd dimension
135      ipk = SIZE(ptab,3)   ! 3rd dimension
136      !
137      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
138
139      DO jk = 1, ipk
140        DO jj = 1, ipj
141          DO ji = 1, ipi
142             ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
143             CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
144          END DO
145        END DO
146      END DO
147      !
148      local_sum_3d = ctmp
149       
150   END FUNCTION local_sum_3d
151
152!                          ! FUNCTION sum3x3 !
153
154   SUBROUTINE sum3x3_2d( p2d )
155      !!-----------------------------------------------------------------------
156      !!                  ***  routine sum3x3_2d  ***
157      !!
158      !! ** Purpose : sum over 3x3 boxes
159      !!----------------------------------------------------------------------
160      REAL(wp), DIMENSION (:,:), INTENT(inout) ::   p2d
161      !
162      INTEGER ::   ji, ji2, jj, jj2     ! dummy loop indices
163      !!----------------------------------------------------------------------
164      !
165      IF( SIZE(p2d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the first dimension is not equal to jpi' ) 
166      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 
167      !
168      ! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
169      !
170      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
171         IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &
172           & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box
173            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
174            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
175            IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
176               p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
177            ENDIF
178         ENDIF
179      END_2D
180      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
181      ! no need for 2nd exchange when nn_hls = 2
182      IF( nn_hls /= 2 ) THEN
183         IF( nbondi /= -1 ) THEN
184            IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
185            IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
186         ENDIF
187         IF( nbondi /=  1 ) THEN
188            IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
189            IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
190         ENDIF
191         IF( nbondj /= -1 ) THEN
192            IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
193            IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
194         ENDIF
195         IF( nbondj /=  1 ) THEN
196            IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
197            IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
198         ENDIF
199         CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
200      ENDIF
201
202   END SUBROUTINE sum3x3_2d
203
204   SUBROUTINE sum3x3_3d( p3d )
205      !!-----------------------------------------------------------------------
206      !!                  ***  routine sum3x3_3d  ***
207      !!
208      !! ** Purpose : sum over 3x3 boxes
209      !!----------------------------------------------------------------------
210      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
211      !
212      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
213      INTEGER ::   ipn                      ! Third dimension size
214      !!----------------------------------------------------------------------
215      !
216      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
217      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
218      ipn = SIZE(p3d,3)
219      !
220      DO jn = 1, ipn
221         !
222         ! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
223         !
224         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
225            IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &
226              & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box
227               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
228               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
229               IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
230                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
231               ENDIF
232            ENDIF
233         END_2D
234      END DO
235      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
236      ! no need for 2nd exchange when nn_hls = 2
237      IF( nn_hls /= 2 ) THEN
238         IF( nbondi /= -1 ) THEN
239            IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:)
240            IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:)
241         ENDIF
242         IF( nbondi /=  1 ) THEN
243            IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:)
244            IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:)
245         ENDIF
246         IF( nbondj /= -1 ) THEN
247            IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:)
248            IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:)
249         ENDIF
250         IF( nbondj /=  1 ) THEN
251            IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:)
252            IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:)
253         ENDIF
254         CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
255      ENDIF
256
257   END SUBROUTINE sum3x3_3d
258
259
260   SUBROUTINE DDPDD( ydda, yddb )
261      !!----------------------------------------------------------------------
262      !!               ***  ROUTINE DDPDD ***
263      !!
264      !! ** Purpose : Add a scalar element to a sum
265      !!
266      !!
267      !! ** Method  : The code uses the compensated summation with doublet
268      !!              (sum,error) emulated useing complex numbers. ydda is the
269      !!               scalar to add to the summ yddb
270      !!
271      !! ** Action  : This does only work for MPI.
272      !!
273      !! References : Using Acurate Arithmetics to Improve Numerical
274      !!              Reproducibility and Sability in Parallel Applications
275      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001
276      !!----------------------------------------------------------------------
277      COMPLEX(dp), INTENT(in   ) ::   ydda
278      COMPLEX(dp), INTENT(inout) ::   yddb
279      !
280      REAL(dp) :: zerr, zt1, zt2  ! local work variables
281      !!-----------------------------------------------------------------------
282      !
283      ! Compute ydda + yddb using Knuth's trick.
284      zt1  = REAL(ydda) + REAL(yddb)
285      zerr = zt1 - REAL(ydda)
286      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
287         &   + AIMAG(ydda)         + AIMAG(yddb)
288      !
289      ! The result is t1 + t2, after normalization.
290      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
291      !
292   END SUBROUTINE DDPDD
293
294#if defined key_nosignedzero
295   !!----------------------------------------------------------------------
296   !!   'key_nosignedzero'                                         F90 SIGN
297   !!----------------------------------------------------------------------
298
299   FUNCTION SIGN_SCALAR( pa, pb )
300      !!-----------------------------------------------------------------------
301      !!                  ***  FUNCTION SIGN_SCALAR  ***
302      !!
303      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
304      !!-----------------------------------------------------------------------
305      REAL(wp) :: pa,pb          ! input
306      REAL(wp) :: SIGN_SCALAR    ! result
307      !!-----------------------------------------------------------------------
308      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
309      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
310      ENDIF
311   END FUNCTION SIGN_SCALAR
312
313
314   FUNCTION SIGN_ARRAY_1D( pa, pb )
315      !!-----------------------------------------------------------------------
316      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
317      !!
318      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
319      !!-----------------------------------------------------------------------
320      REAL(wp) :: pa,pb(:)                   ! input
321      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
322      !!-----------------------------------------------------------------------
323      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
324      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
325      END WHERE
326   END FUNCTION SIGN_ARRAY_1D
327
328
329   FUNCTION SIGN_ARRAY_2D(pa,pb)
330      !!-----------------------------------------------------------------------
331      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
332      !!
333      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
334      !!-----------------------------------------------------------------------
335      REAL(wp) :: pa,pb(:,:)      ! input
336      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
337      !!-----------------------------------------------------------------------
338      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
339      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
340      END WHERE
341   END FUNCTION SIGN_ARRAY_2D
342
343   FUNCTION SIGN_ARRAY_3D(pa,pb)
344      !!-----------------------------------------------------------------------
345      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
346      !!
347      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
348      !!-----------------------------------------------------------------------
349      REAL(wp) :: pa,pb(:,:,:)      ! input
350      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
351      !!-----------------------------------------------------------------------
352      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
353      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
354      END WHERE
355   END FUNCTION SIGN_ARRAY_3D
356
357
358   FUNCTION SIGN_ARRAY_1D_A(pa,pb)
359      !!-----------------------------------------------------------------------
360      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
361      !!
362      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
363      !!-----------------------------------------------------------------------
364      REAL(wp) :: pa(:),pb(:)      ! input
365      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
366      !!-----------------------------------------------------------------------
367      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
368      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
369      END WHERE
370   END FUNCTION SIGN_ARRAY_1D_A
371
372
373   FUNCTION SIGN_ARRAY_2D_A(pa,pb)
374      !!-----------------------------------------------------------------------
375      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
376      !!
377      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
378      !!-----------------------------------------------------------------------
379      REAL(wp) :: pa(:,:),pb(:,:)      ! input
380      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
381      !!-----------------------------------------------------------------------
382      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
383      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
384      END WHERE
385   END FUNCTION SIGN_ARRAY_2D_A
386
387
388   FUNCTION SIGN_ARRAY_3D_A(pa,pb)
389      !!-----------------------------------------------------------------------
390      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
391      !!
392      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
393      !!-----------------------------------------------------------------------
394      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
395      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
396      !!-----------------------------------------------------------------------
397      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
398      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
399      END WHERE
400   END FUNCTION SIGN_ARRAY_3D_A
401
402
403   FUNCTION SIGN_ARRAY_1D_B(pa,pb)
404      !!-----------------------------------------------------------------------
405      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
406      !!
407      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
408      !!-----------------------------------------------------------------------
409      REAL(wp) :: pa(:),pb      ! input
410      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
411      !!-----------------------------------------------------------------------
412      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
413      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
414      ENDIF
415   END FUNCTION SIGN_ARRAY_1D_B
416
417
418   FUNCTION SIGN_ARRAY_2D_B(pa,pb)
419      !!-----------------------------------------------------------------------
420      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
421      !!
422      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
423      !!-----------------------------------------------------------------------
424      REAL(wp) :: pa(:,:),pb      ! input
425      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
426      !!-----------------------------------------------------------------------
427      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
428      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
429      ENDIF
430   END FUNCTION SIGN_ARRAY_2D_B
431
432
433   FUNCTION SIGN_ARRAY_3D_B(pa,pb)
434      !!-----------------------------------------------------------------------
435      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
436      !!
437      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
438      !!-----------------------------------------------------------------------
439      REAL(wp) :: pa(:,:,:),pb      ! input
440      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
441      !!-----------------------------------------------------------------------
442      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
443      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
444      ENDIF
445   END FUNCTION SIGN_ARRAY_3D_B
446#endif
447
448   !!======================================================================
449END MODULE lib_fortran
Note: See TracBrowser for help on using the repository browser.