bling/pkg/bling_read_pickup.F

C $Header:  $
C $Name:  $

#include "BLING_OPTIONS.h"

CBOP
      subroutine BLING_READ_PICKUP(
     O                            pH_isLoaded,
     I                            myIter, myThid )

C     ==========================================================
C     | subroutine bling_read_pickup
C     | o 
C     ==========================================================

      implicit none
      
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "BLING_VARS.h"

C     == Routine arguments ==
C     myThid  :: my Thread Id number
      LOGICAL pH_isLoaded
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_BLING

C     !FUNCTIONS

C     !LOCAL VARIABLES:
C     == Local variables ==
      CHARACTER*(MAX_LEN_FNAM) fn, filNam
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      LOGICAL useCurrentDir, fileExist
      INTEGER fp, ioUnit
CEOP

      pH_isLoaded =.FALSE.
      ioUnit = errorMessageUnit

C--   pickup file name :
      IF (pickupSuff.EQ.' ') THEN
        WRITE(fn,'(A,I10.10)') 'pickup_dic.', myIter
      ELSE
        WRITE(fn,'(A,A10)') 'pickup_dic.', pickupSuff
      ENDIF
      fp = precFloat64

C--   First check if pickup file exist
#ifdef ALLOW_MDSIO
      useCurrentDir = .FALSE.
      CALL MDS_CHECK4FILE(
     I                     fn, '.data', 'BLING_READ_PICKUP',
     O                     filNam, fileExist,
     I                     useCurrentDir, myThid )
#else
      STOP 'ABNORMAL END: S/R BLING_READ_PICKUP: Needs MDSIO pkg'
#endif

      IF ( fileExist ) THEN
C--   Read pickup file
        CALL READ_REC_3D_RL( fn, fp, Nr, pH, 1, myIter, myThid )
        pH_isLoaded = .TRUE.

        _EXCH_XYZ_RL( pH, myThid )
      ELSE
        pH_isLoaded = .FALSE.
        IF ( pickupStrictlyMatch ) THEN
          WRITE(msgBuf,'(4A)') 'BLING_READ_PICKUP: ',
     &      'try with " pickupStrictlyMatch=.FALSE.,"',
     &      ' in file: "data", NameList: "PARM03"'
          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
          STOP 'ABNORMAL END: S/R BLING_READ_PICKUP'
        ELSE
          WRITE(msgBuf,'(2A)') 'WARNING >> BLING_READ_PICKUP: ',
     &      'will restart from approximated pH'
          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
        ENDIF
      ENDIF

#endif /*  ALLOW_BLING  */

      RETURN
      END
1	C $Header: $
2	C $Name: $
3
4	#include "BLING_OPTIONS.h"
5
6	CBOP
7	subroutine BLING_READ_PICKUP(
8	O pH_isLoaded,
9	I myIter, myThid )
10
11	C ==========================================================
12	C \| subroutine bling_read_pickup
13	C \| o
14	C ==========================================================
15
16	implicit none
17
18	C === Global variables ===
19	#include "SIZE.h"
20	#include "EEPARAMS.h"
21	#include "PARAMS.h"
22	#include "BLING_VARS.h"
23
24	C == Routine arguments ==
25	C myThid :: my Thread Id number
26	LOGICAL pH_isLoaded
27	INTEGER myIter
28	INTEGER myThid
29
30	#ifdef ALLOW_BLING
31
32	C !FUNCTIONS
33
34	C !LOCAL VARIABLES:
35	C == Local variables ==
36	CHARACTER*(MAX_LEN_FNAM) fn, filNam
37	CHARACTER*(MAX_LEN_MBUF) msgBuf
38	LOGICAL useCurrentDir, fileExist
39	INTEGER fp, ioUnit
40	CEOP
41
42	pH_isLoaded =.FALSE.
43	ioUnit = errorMessageUnit
44
45	C-- pickup file name :
46	IF (pickupSuff.EQ.' ') THEN
47	WRITE(fn,'(A,I10.10)') 'pickup_dic.', myIter
48	ELSE
49	WRITE(fn,'(A,A10)') 'pickup_dic.', pickupSuff
50	ENDIF
51	fp = precFloat64
52
53	C-- First check if pickup file exist
54	#ifdef ALLOW_MDSIO
55	useCurrentDir = .FALSE.
56	CALL MDS_CHECK4FILE(
57	I fn, '.data', 'BLING_READ_PICKUP',
58	O filNam, fileExist,
59	I useCurrentDir, myThid )
60	#else
61	STOP 'ABNORMAL END: S/R BLING_READ_PICKUP: Needs MDSIO pkg'
62	#endif
63
64	IF ( fileExist ) THEN
65	C-- Read pickup file
66	CALL READ_REC_3D_RL( fn, fp, Nr, pH, 1, myIter, myThid )
67	pH_isLoaded = .TRUE.
68
69	_EXCH_XYZ_RL( pH, myThid )
70	ELSE
71	pH_isLoaded = .FALSE.
72	IF ( pickupStrictlyMatch ) THEN
73	WRITE(msgBuf,'(4A)') 'BLING_READ_PICKUP: ',
74	& 'try with " pickupStrictlyMatch=.FALSE.,"',
75	& ' in file: "data", NameList: "PARM03"'
76	CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
77	STOP 'ABNORMAL END: S/R BLING_READ_PICKUP'
78	ELSE
79	WRITE(msgBuf,'(2A)') 'WARNING >> BLING_READ_PICKUP: ',
80	& 'will restart from approximated pH'
81	CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
82	ENDIF
83	ENDIF
84
85	#endif /* ALLOW_BLING */
86
87	RETURN
88	END