Oasis3 4.0.2
|
00001 SUBROUTINE locrint (cdfldn, kfield, kdimax, knulre, kflgre) 00002 C**** 00003 C ***************************** 00004 C * OASIS ROUTINE - LEVEL 0 * 00005 C * ------------- ------- * 00006 C ***************************** 00007 C 00008 C**** *locrint* - Read binary integer field on unit knulre 00009 C 00010 C Purpose: 00011 C ------- 00012 C Find string cdfldn on unit knulre and read integer array pfield 00013 C 00014 C** Interface: 00015 C --------- 00016 C *CALL* *locrint (cdfldn, kfield, kdimax, knulre, kflgre)* 00017 C 00018 C Input: 00019 C ----- 00020 C cdfldn : character string locator 00021 C kdimax : dimension of field to be read 00022 C knulre : logical unit to be read 00023 C 00024 C Output: 00025 C ------ 00026 C kfield : field array (integer 1D) 00027 C kflgre : error status flag 00028 C 00029 C Workspace: 00030 C --------- 00031 C None 00032 C 00033 C Externals: 00034 C --------- 00035 C None 00036 C 00037 C Reference: 00038 C --------- 00039 C See OASIS manual (1995) 00040 C 00041 C History: 00042 C ------- 00043 C Version Programmer Date Description 00044 C ------- ---------- ---- ----------- 00045 C 2.0 L. Terray 95/09/01 created 00046 C 2.3 S. Valcke 99/04/30 added: printing levels 00047 C 00048 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00049 C 00050 C* ---------------------------- Include files --------------------------- 00051 C 00052 USE mod_unit 00053 USE mod_printing 00054 C 00055 C* ---------------------------- Argument declarations ------------------- 00056 C 00057 INTEGER (kind=ip_intwp_p) kfield(kdimax) 00058 CHARACTER*8 cdfldn 00059 C 00060 C* ---------------------------- Local declarations ---------------------- 00061 C 00062 CHARACTER*8 clecfl 00063 C 00064 C* ---------------------------- Poema verses ---------------------------- 00065 C 00066 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00067 C 00068 C* 1. Initialization 00069 C -------------- 00070 C 00071 IF (nlogprt .GE. 2) THEN 00072 WRITE (UNIT = nulou,FMT = *)' ' 00073 WRITE (UNIT = nulou,FMT = *)' ROUTINE locrint - Level 0' 00074 WRITE (UNIT = nulou,FMT = *)' *************** *******' 00075 WRITE (UNIT = nulou,FMT = *)' ' 00076 WRITE (UNIT = nulou,FMT = 1001) knulre 00077 WRITE (UNIT = nulou,FMT = *)' ' 00078 CALL FLUSH(nulou) 00079 ENDIF 00080 C 00081 C* Formats 00082 C 00083 1001 FORMAT(5X,' Read binary file connected to unit = ',I3) 00084 C 00085 C 2. Find field in file 00086 C ------------------ 00087 C 00088 REWIND knulre 00089 200 CONTINUE 00090 C* Find string 00091 READ (UNIT = knulre, ERR = 200, END = 210) clecfl 00092 IF (clecfl .NE. cdfldn) GO TO 200 00093 C* Read associated field 00094 READ (UNIT = knulre, ERR = 210, END = 210) kfield 00095 C* Reading done and ok 00096 kflgre = 0 00097 GO TO 220 00098 C* Problem in reading 00099 210 kflgre = 1 00100 220 CONTINUE 00101 C 00102 C 00103 C* 3. End of routine 00104 C -------------- 00105 C 00106 IF (nlogprt .GE. 2) THEN 00107 WRITE (UNIT = nulou,FMT = *) 00108 $ ' --------- End of ROUTINE locrint ---------' 00109 WRITE (UNIT = nulou,FMT = *) ' ' 00110 CALL FLUSH (nulou) 00111 ENDIF 00112 RETURN 00113 END 00114 00115