copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r invhtm -- Special case for heigths *subroutine invhtm (fnew, nif, njf, nkf, 1 $ ht,hw, lminx, lmaxx, lminy, lmaxy, lnk) implicit none * integer nif,njf,nkf,lminx,lmaxx,lminy,lmaxy,lnk real fnew(nif*njf,nkf),ht(lminx:lmaxx,lminy:lmaxy,lnk), $ hw(lminx:lmaxx,lminy:lmaxy,lnk) * *AUTHOR Michel Desgagne October 2003 * *REVISION * *ARGUMENTS * NAMES I/O TYPE A/S DESCRIPTION * * fnew O R A field containing inverted levels * ht I R A heigths of thermo levelv T * hm I R A heigths of thermo levelv W * nif I I S first hor. dimension of fnew * njf I I S second hor. dimension of fnew * nkf I I S vertical dimension of fnew * nis I I S first dimension of f * njs I I S second dimension of f * nk I I S vertical dimension of f and fnew * ni I I S computational hor. dimension along X * nj I I S computational hor. dimension along Y * *IMPLICIT #include "lcldim.cdk"
#include "topo.cdk"
#include "consdyn_8.cdk"
* *MODULES * ** integer i,j,k,nkompte *---------------------------------------------------------------------- * nkompte=lnk/2 do 1 k=1,nkompte do 1 j=1,ldnj do 1 i=1,ldni fnew((j-1)*ldni+i,k) = (ht(i,j,lnk-k+1)-hh0(i,j,1))*grav_8 fnew((j-1)*ldni+i,lnk-k+1)= (ht(i,j, k)-hh0(i,j,1))*grav_8 1 continue if (mod(lnk,2).ne.0) then do 2 j=1,ldnj do 2 i=1,ldni fnew((j-1)*ldni+i,nkompte+1)= (ht(i,j,nkompte+1)-hh0(i,j,1)) $ *grav_8 2 continue endif * do 3 j=1,ldnj do 3 i=1,ldni fnew((j-1)*ldni+i,nkf)= 0. 3 continue * do 4 k=1,nkf do 4 i=ldni*ldnj+1,nif*njf fnew(i,k) = fnew(ldni*ldnj,k) 4 continue * *---------------------------------------------------------------------- return end