From 84976472b2e69ca82820967251c4d0276c836d43 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=D0=91=D1=8B=D1=87=D0=BA=D0=BE=D0=B2=D0=B0=20=D0=92=D0=B8?=
=?UTF-8?q?=D0=BA=D1=82=D0=BE=D1=80=D0=B8=D1=8F?=
<vika@DESKTOP-QMFV82V.localdomain>
Date: Mon, 9 Oct 2023 16:19:00 +0300
Subject: [PATCH] add ddt
---
compile2.sh | 10 +++
drag3.f90 | 224 ++++++++++++++++++++++++++++++++++++++++++++++++++
inputdata.f90 | 4 -
main_drag.f90 | 33 ++++++++
param.f90 | 2 -
5 files changed, 267 insertions(+), 6 deletions(-)
create mode 100644 compile2.sh
create mode 100644 drag3.f90
create mode 100644 main_drag.f90
diff --git a/compile2.sh b/compile2.sh
new file mode 100644
index 0000000..b6966b8
--- /dev/null
+++ b/compile2.sh
@@ -0,0 +1,10 @@
+#!/bin/bash
+
+rm drag_ddt.exe *.o
+gfortran -c inputdata.f90
+gfortran -c param.f90
+gfortran -c prmt.f90
+gfortran -c drag3.f90
+gfortran -c main_drag.f90
+gfortran -o drag_ddt.exe main_drag.o drag3.o inputdata.o param.o prmt.o
+
diff --git a/drag3.f90 b/drag3.f90
new file mode 100644
index 0000000..860abae
--- /dev/null
+++ b/drag3.f90
@@ -0,0 +1,224 @@
+ module DRAG3
+
+ USE PRMT
+ USE PARAM
+ USE INPUTDATA
+
+ !implicit real (A-H, O-Z)
+ implicit none
+ type, public:: DATA_IN
+ real, public:: WS, DT, ST, DQ, CFLH, Z0IN
+ end type
+
+ type, public:: DATA_OUTDEF
+ real, public:: ZL, RI, RE, LNZUZT, ZU, ZTOUT, RITH, CM, CH, CT, CKT
+ end type
+
+ type, public:: DATA_PAR
+ integer, public :: IT=10
+ end type
+
+
+ contains
+
+ subroutine surf_flux(in, out, par)
+ type (DATA_IN) , intent(in) :: in
+ type (DATA_OUTDEF) out
+ type (DATA_PAR) par
+
+ real WS, DT, ST, DQ, CFLH, Z0IN
+ integer IT
+ real ZL, RI, RE, LNZUZT, ZU, ZTIN, RI_TH, CM, CH, CT, CKT
+ real Z0, D3, D0MAX, U1, A1, Y1, CIMIN, H1, AP0, F, A2, C1, U2, H0, U3, X7, X8, AN1, AN2, D0, D00, ZT, H00, FT0, AN4, AN5
+ real AL, AL2, AN, G, T1, R6, Q4, T4, U, G0, R1, F0, F4, A0, AM, O, DD, X1, Y0, X0, Z3, Y10, A2CH, X10, P1, P0, H, D1, F1
+ real D, C4, C1MIN, C0, C, B1, AN0
+ integer i, j, m
+ WS=in%WS
+ DT=in%DT
+ ST=in%ST
+ DQ=in%DQ
+ CFLH=in%CFLH
+ Z0IN=in%Z0IN
+ IT=par%IT
+
+ U=WS
+ T4=DT
+ T1=ST
+ Q4=DQ
+ H=CFLH
+ Z0=Z0IN
+
+ D3=0.0E0
+ D0MAX=2.0E0
+ !=DATA_IN%WS
+ !4=DATA_IN%DT
+ !4=DATA_IN%DQ
+ !=DATA_IN%CFLH
+ !0=DATA_IN%Z0
+ IF(Z0.LT.0.0E0) D0MAX=8.0E0
+ IF(Z0.LT.0.0E0) THEN
+! ......DEFINITION Z0 OF SEA SURFACE......
+ !call Z0SEA module (RAMIL_DASHA)
+ !U1=U
+ !A1=0.0E0
+ !Y1=25.0E0
+ !C1MIN=ALOG(H1/1.0E0)/AP0
+ !DO 630 I=1,IT
+ !F=A2-2.0E0*ALOG(U1)
+ !DO 570 J=1,IT
+ !C1=(F+2.0E0*ALOG(Y1))/AP0
+ !IF(U.LE.8.0E0) A1=ALOG(1.0E0+A3*((Y1/U1)**3))/AP0
+ !C1=C1-A1
+ !C1=AMAX1(C1,C1MIN)
+ !Y1=C1
+ !570 CONTINUE
+ ! Z0=H1*EXP(-C1*AP0)
+ ! Z0=AMAX1(Z0,0.000015E0)
+ ! U2=U*ALOG(H1/Z0)/(ALOG(H/Z0))
+ ! U1=U2
+ !630 CONTINUE
+ ! J=1
+ ! H0=H/Z0
+ ! U3=U1/C1
+ ! ELSE
+! ......PARAMETERS FROM VISCOSITY SUBLAYER......
+ ! J=0
+ ! H0=H/Z0
+ ! U3=U*AP0/ALOG(H0)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ END IF
+ X7=U3*Z0/AN
+ IF(X7.LE.X8) THEN
+ D0=AN1*ALOG(AL1*X7)+AN2
+ ELSE
+ D0=AL2*(X7**0.45E0)
+ END IF
+! ......HUMIDITY STRATIFICATION AND RI-NUMBER......
+ ST=in%ST
+ AL=G/T1
+ D0=AMIN1(D0,D0MAX)
+ R6=AL*H*(T4+0.61E0*T1*Q4)/U**2
+ D00=D0
+ ZT=Z0/EXP(D00)
+ H00=H/ZT
+ FT0=ALOG(H00)
+! ......DEFINITION OF R-PRIM......
+ AN4=D1/H0
+ AN5=D1/H00
+!C IF(D0.EQ.0.0E0) AN5=AN4
+ IF (ABS(D0).LT.1.0E-10) AN5=AN4
+ AN5=SQRT(1.0E0-G0*AN5)
+ AN4=(1.0E0-G4*AN4)**0.25E0
+ F0=ALOG((X10-1.0E0)*(AN5+1.0E0)/((X10+1.0E0)*(AN5-1.0E0)))/A0
+ F4=2.0E0*(ATAN(Y10)-ATAN(AN4))+ALOG((Y10-1.0E0)*(AN4+1.0E0)/((Y10+1.0E0)*(AN4-1.0E0)))
+ R1=D1*F0/(F4*F4)
+! ......DEFINITION OF DZ,TA,FU,FO,FIU,FIO......
+ IF(R6.GT.0.0E0) GO TO 1460
+ IF(R6.LT.R1) GO TO 1305
+ IF(R6.GT.-0.001E0) THEN
+! ......NEARLY NEUTRAL......
+ write (*,*) 'NEUTRAL'
+ F4=ALOG(H0)
+ F0=FT0/A0
+! IF(D0.EQ.0.0E0) F0=F4/A0
+ IF (ABS(D0).LT.1.0E-10) F0=F4/A0
+ AM=1.0E0
+ O=1.0E0/A0
+ GO TO 1570
+ ELSE
+! ......WEEK AND SEMISTRONG INSTABILITY......
+ write (*,*) 'SEMISTRONG'
+ F1=ALOG(H0)
+! IF(D0.EQ.0.0E0)FT0=F1
+ IF (ABS(D0).LT.1.0E-10) FT0=F1
+ D3=R6*A0*F1**2/FT0
+ M=1
+ 1245 DO 1300 I=1,IT
+ D=D3/H0
+ DD=D3/H00
+! IF(D0.EQ.0.0E0)DD=D
+ IF (ABS(D0).LT.1.0E-10) DD=D
+ Y1=(1.0E0-G4*D3)**0.25E0
+ X1=SQRT(1.0E0-G0*D3)
+ Y0=(1.0E0-G4*D)**0.25E0
+ X0=SQRT(1.0E0-G0*DD)
+ Y0=AMAX1(Y0,1.000001E0)
+ X0=AMAX1(X0,1.000001E0)
+ F4=ALOG((Y1-1.0E0)*(Y0+1.0E0)/((Y1+1.0E0)*(Y0-1.0E0)))+2.0E0*(ATAN(Y1)-ATAN(Y0))
+ F0=ALOG((X1-1.0E0)*(X0+1.0E0)/((X1+1.0E0)*(X0-1.0E0)))/A0
+ IF(M.NE.1) GO TO 1350
+ Z3=R6*F4**2/F0
+ D3=Z3
+ 1300 CONTINUE
+ M=2
+ GO TO 1245
+ 1350 AM=(1.0E0-G4*D3)**(-0.25E0)
+ O=1.0E0/(A0*SQRT(1.0E0-G0*D3))
+ GO TO 1570
+ END IF
+! ......STRONG INSTABILITY.....
+ 1305 CONTINUE
+ write (*,*) 'INSTABILITY'
+ D3=D1
+ M=1
+ 1355 DO 1410 I=1,IT
+ D=D3/H0
+ DD=D3/H00
+! IF(D0.EQ.0.0E0)DD=D
+ IF (ABS(D0).LT.1.0E-10) DD=D
+ A1=(D1/D3)**(1.0E0/3.0E0)
+ X0=SQRT(1.0E0-G0*DD)
+ Y0=(1.0E0-G4*D)**0.25E0
+ C=ALOG((X0+1.0E0)/(X0-1.0E0))
+ B1=-2.0E0*ATAN(Y0)+ALOG((Y0+1.0E0)/(Y0-1.0E0))
+ F=3.0E0*(1.0E0-A1)
+ F4=F/Y10+P1+B1
+ F0=(F/X10+P0+C)/A0
+ IF(M.NE.1) GO TO 1430
+ Z3=R6*F4**2/F0
+ D3=Z3
+ 1410 CONTINUE
+ M=2
+ GO TO 1355
+ 1430 AM=A1/Y10
+ O=A1/(A0*X10)
+ GO TO 1570
+! ......STABLE STRATIFICATION......
+ 1460 CONTINUE
+ write (*,*) 'STABLE'
+ R6=AMIN1(R6,R0)
+ F=ALOG(H0)
+ F1=D0/F
+ A1=B4*R6
+ A2CH=(F1+1.0E0)/A0-2.0E0*A1
+ D3=F*(SQRT(A2CH**2+4.0E0*A1*(1.0E0-A1))-A2CH)/(2.0E0*B4*(1.0E0-A1))
+ F1=B4*D3
+ F4=F+F1
+ F0=(F+D0)/A0+F1
+ O=1.0E0/A0+F1
+ AM=1.0E0+F1
+ 1570 CONTINUE
+! ......COMPUTATION OF CU,CO,K(H),ALFT
+ C4=AP0/F4
+ C0=AP0/F0
+ AN4=AP0*C4*U*H/AM
+ AN0=AM/O
+! ......EXIT......
+ 140 CONTINUE
+ out%ZL=D3
+ out%RI=R6
+ out%RE=X7
+ out%LNZUZT=D00
+ out%ZU=Z0
+ out%ZTOUT=ZT
+ out%RITH=R1
+ out%CM=C4
+ out%CH=C0
+ out%CT=AN4
+ out%CKT=AN0
+
+
+
+ return
+ end subroutine surf_flux
+ end module DRAG3
\ No newline at end of file
diff --git a/inputdata.f90 b/inputdata.f90
index 41886e3..8fb6737 100644
--- a/inputdata.f90
+++ b/inputdata.f90
@@ -2,10 +2,6 @@ module INPUTDATA
REAl, DIMENSION (6) :: AR1
REAl, DIMENSION (11) :: AR2
INTEGER, PARAMETER :: IT =1
- INTEGER, PARAMETER :: N=7094
- REAL HFX, MFX, zL, betta
- REAL U, T4,C0,C4, T1,H
- REAL ws, deltaT, semisumT
!C*====================================================================
!C* .....DEFENITION OF DRAG AND HEAT EXCHANGE COEFFICIENTS...... =
!C* DETAILS OF ALGORITM ARE GIVEN IN: =
diff --git a/main_drag.f90 b/main_drag.f90
new file mode 100644
index 0000000..4e50962
--- /dev/null
+++ b/main_drag.f90
@@ -0,0 +1,33 @@
+program main_ddt
+ USE PRMT
+ USE PARAM
+ USE INPUTDATA
+ use DRAG3
+
+ type (DATA_IN):: DATA_IN1
+
+ type (DATA_OUTDEF) :: DATA_OUTDEF1
+
+
+ type (DATA_PAR) :: DATA_PAR1
+
+
+ OPEN (1,FILE='4_ddt.txt')
+
+ DO I = 1,1000000
+ READ (1,*,END=100) DATA_IN1%WS, DATA_IN1%DT
+
+
+ call surf_flux(DATA_IN1, DATA_OUTDEF1, DATA_PAR1)
+
+
+
+ ENDDO
+
+100 CONTINUE
+
+10 FORMAT (4I4,5F7.1,F7.4,F7.1)
+20 FORMAT (4I4,5F7.1,F7.4,F7.1)
+
+stop
+end program
diff --git a/param.f90 b/param.f90
index 5a39ca4..ee8540e 100644
--- a/param.f90
+++ b/param.f90
@@ -1,7 +1,5 @@
module PARAM
IMPLICIT REAL (A-H,O-Z)
- real, parameter :: RO = 1.2
- real, parameter :: CP =8.4
real, parameter :: AKA=.40E0
real, parameter :: AP0=.40E0
real, parameter :: G=9.81E0
--
GitLab