*=*=*=*= lwi.html =*=*=*=*
subroutine lwi (ig0,kdlon,kflev,psi,zdblay,pdp . ,newpcolc ) implicit logical (l) #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" #include "comg1d.h" #include "callkeys.h" #include "comcstfi.h" CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C - lwi - C C PURPOSE: Shema semi - implicite C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC #include "yomrad.h" #include "yomaer.h" #include "yomlw.h" #include "yomsw.h" #include "yomrdu.h" c************************************************************************ c c 0. Declarations c ------------ c c------------------------------------------------------------------------- c 0.1 Arguments c --------- c integer ig0 real psi(ndlo2,kflev) . , zdblay(ndlo2,nir,kflev) . , pdp(ndlo2,kflev) real newpcolc(ndlo2,kflev) c------------------------------------------------------------------------- c 0.2 local arrays c ------------ c real di(ndlon,nflev) . , hi(ndlon,nflev) . , bi(ndlon,nflev) real , ci(ndlon,nflev) . , ai(ndlon,nflev) real semit real xi (ngridmx,nuco2,0:nlayermx+1,0:nlayermx+1) common/ksicom/xi c************************************************************************ c c 1. Initialisations c --------------- c c----------------------------------------------------------------------- deltat = dtphys * iradia c print*,'SEMI = ',semi, '(expl:0 semi-implicite:0.5 impl:1)' semit = semi * deltat c semi = 0. c print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit c print*,'g,cpp',g,cpp c************************************************************************ c c 2. c --------------- c c------------------------------------------------------------------------- c 2.1 Calcul des di c ------------- c do i = 1 , kflev-1 do jl = 1 , kdlon c ------------------- di(jl,i) = 1 + semit * (g / pdp(jl,i) / cpp) * ( . ( xi(ig0+jl,1,i,kflev+1) . + xi(ig0+jl,1,i,i+1) . + xi(ig0+jl,1,i,i-1) ) . * zdblay(jl,1,i) . + ( xi(ig0+jl,2,i,kflev+1) . + xi(ig0+jl,2,i,i+1) . + xi(ig0+jl,2,i,i-1) ) . * zdblay(jl,2,i) . ) c ------------------- enddo enddo c couche kflev c ------------ c , on enleve i,i+1 sinon on a 2 fois le cooling2space do jl = 1 , kdlon c ------------------- di(jl,kflev) = 1 + semit * (g / pdp(jl,kflev) / cpp) * ( . ( xi(ig0+jl,1,kflev,kflev+1) . + xi(ig0+jl,1,kflev,kflev-1) ) . * zdblay(jl,1,kflev) . + ( xi(ig0+jl,2,kflev,kflev+1) . + xi(ig0+jl,2,kflev,kflev-1) ) . * zdblay(jl,2,kflev) . ) c ------------------- enddo c------------------------------------------------------------------------- c 2.2 Calcul des hi c ------------- c do i = 1 , kflev-1 do jl = 1 , kdlon c ------------------- hi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * . ( xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1) . + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1) ) c ------------------- enddo enddo c------------------------------------------------------------------------- c 2.3 Calcul des bi c ------------- c do i = 2 , kflev do jl = 1 , kdlon c ------------------- bi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * . ( xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1) . + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1) ) c ------------------- enddo enddo c couche 1 c -------- c tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de c la discontinuite de temperature au sol , on met b1 = 0 do jl = 1 , kdlon bi(jl,1) = 0 enddo c------------------------------------------------------------------------- c 2.4 c ------------- c c couche kflev c ------------ do jl = 1 , kdlon c ------------------- ci(jl,kflev) = (cday * psi(jl,kflev) / pdp(jl,kflev)) . / di(jl,kflev) ai(jl,kflev) = - bi(jl,kflev) / di(jl,kflev) c ------------------- enddo do i = kflev-1 , 1 , -1 do jl = 1 , kdlon c ------------------- denom = di(jl,i) + hi(jl,i) * ai(jl,i+1) ci(jl,i) = ( cday * psi(jl,i) / pdp(jl,i) . - hi(jl,i) * ci(jl,i+1) ) / denom ai(jl,i) = -bi(jl,i) / denom c ------------------- enddo enddo c------------------------------------------------------------------------- c 2.5 c ------------- c c couche 1 c ------- do jl = 1 , kdlon newpcolc(jl,1) = ci(jl,1) enddo do i = 2 , kflev do jl = 1 , kdlon newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1) enddo enddo c------------------------------------------------------------------------- RETURN END