source: CPL/oasis3/trunk/src/mod/oasis3/src/getfpe.f @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 2.3 KB
Line 
1      SUBROUTINE getfpe
2C****
3C               *****************************
4C               * OASIS ROUTINE  -  LEVEL C *
5C               * -------------     ------- *
6C               *****************************
7C
8C**** *getfpe*  - Signal handler
9C
10C     Purpose:
11C     -------
12C     getfpe is executed each time signal sigfpe is caught.
13C     Then code stops due to floating point exception error.
14C
15C**   Interface:
16C     ---------
17C
18C     Input:
19C     -----
20C     None
21C
22C     Output:
23C     ------
24C     None
25C
26C     Workspace:
27C     ---------
28C     None
29C
30C     Externals:
31C     ---------
32C     None
33C
34C     Reference:
35C     ---------
36C     Epicoa 920203 (1992) and OASIS manual (1995) 
37C
38C     History:
39C     -------
40C       Version   Programmer     Date      Description
41C       -------   ----------     ----      ----------- 
42C       1.0       L. Terray      94/01/01  created
43C       2.0       L. Terray      95/09/10  modified: new structure
44C
45C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
46C
47C* ---------------------------- Include files ---------------------------
48C
49      USE mod_unit
50C
51C* ---------------------------- Poema verses ----------------------------
52C
53C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
54C
55C*    1. Initialization
56C        --------------
57C
58      WRITE (UNIT = nulou,FMT = *) ' '
59      WRITE (UNIT = nulou,FMT = *) ' '
60      WRITE (UNIT = nulou,FMT = *) 
61     $    '           ROUTINE getfpe  -  Level C'
62      WRITE (UNIT = nulou,FMT = *) 
63     $    '           **************     *******'
64      WRITE (UNIT = nulou,FMT = *) ' '
65      WRITE (UNIT = nulou,FMT = *) ' catch fpe error '
66      WRITE (UNIT = nulou,FMT = *) ' '
67      WRITE (UNIT = nulou,FMT = *) ' '
68C
69C
70C*    2. Abort simulation in case of floating point error
71C        ------------------------------------------------
72C
73      WRITE (UNIT = nulou,FMT = *) '        ***WARNING***'
74      WRITE (UNIT = nulou,FMT = *) 
75     $       ' ===>>> : fpe error has occurred in coupler'
76      WRITE (UNIT = nulou,FMT = *) 
77     $       ' ======   === =====                 ======='
78      WRITE (UNIT = nulou,FMT = *) ' '
79      WRITE (UNIT = nulou,FMT = *) 
80     $       ' We STOP !!! Check non initialized variables'
81      CALL FLUSH (nulou)
82      CALL HALTE ('STOP in getfpe')
83C
84C
85C*    3. End of routine
86C        --------------
87C
88      RETURN
89      END
Note: See TracBrowser for help on using the repository browser.