Merge branch '2-add-derived-data-types' into 'main'

Resolve "ADD derived data types"

Closes #2

See merge request inmcm60_pbl/inmcm60_sfx!1

compile2.sh

+#!/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 
+

drag3.f90

+        MODULE drag3
+   
+      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

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:                             =

main_drag.f90

+   PROGRAM main_ddt
+   
+    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
\ No newline at end of file

param.f90

 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