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