Oasis3 4.0.2
|
00001 SUBROUTINE locwrite (cdfldn, pfield, kdimax, knulre, kflgre) 00002 C**** 00003 C ***************************** 00004 C * OASIS ROUTINE - LEVEL 0 * 00005 C * ------------- ------- * 00006 C ***************************** 00007 C 00008 C**** *locwrite* - Write binary field on unit knulre 00009 C 00010 C Purpose: 00011 C ------- 00012 C Write string cdfldn and array pfield on unit knulre 00013 C 00014 C** Interface: 00015 C --------- 00016 C *CALL* *locwrite (cdfldn, pfield, kdimax, knulre, kflgre)* 00017 C 00018 C Input: 00019 C ----- 00020 C cdfldn : character string locator 00021 C kdimax : dimension of field to be written 00022 C knulre : logical unit to be written 00023 C pfield : field array (real 1D) 00024 C 00025 C Output: 00026 C ------ 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 REAL (kind=ip_realwp_p) pfield(kdimax) 00058 CHARACTER*8 cdfldn 00059 C 00060 C* ---------------------------- Poema verses ---------------------------- 00061 C 00062 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00063 C 00064 C* 1. Initialization 00065 C -------------- 00066 C 00067 IF (nlogprt .GE. 2) THEN 00068 WRITE (UNIT = nulou,FMT = *)' ' 00069 WRITE (UNIT = nulou,FMT = *)' ROUTINE locwrite - Level 0' 00070 WRITE (UNIT = nulou,FMT = *)' **************** *******' 00071 WRITE (UNIT = nulou,FMT = *)' ' 00072 WRITE (UNIT = nulou,FMT = 1001) knulre 00073 WRITE (UNIT = nulou,FMT = *)' ' 00074 CALL FLUSH (nulou) 00075 ENDIF 00076 C 00077 C* Formats 00078 C 00079 1001 FORMAT(5X,' Write binary file connected to unit = ',I3) 00080 C 00081 C 2. Find field in file 00082 C ------------------ 00083 C 00084 C* Write string 00085 WRITE (UNIT = knulre, ERR = 210) cdfldn 00086 C* Write associated field 00087 WRITE (UNIT = knulre, ERR = 210) pfield 00088 C* Writing done and ok 00089 kflgre = 0 00090 GO TO 220 00091 C* Problem in Writing 00092 210 kflgre = 1 00093 220 CONTINUE 00094 C 00095 C 00096 C* 3. End of routine 00097 C -------------- 00098 C 00099 IF (nlogprt .GE. 2) THEN 00100 WRITE (UNIT = nulou,FMT = *) 00101 $ ' --------- End of ROUTINE locwrite ---------' 00102 WRITE (UNIT = nulou,FMT = *) ' ' 00103 CALL FLUSH (nulou) 00104 ENDIF 00105 RETURN 00106 END 00107 00108