54 USE yomhook
,ONLY : lhook, dr_hook
55 USE parkind1
,ONLY : jprb
61 INTEGER,
INTENT(IN) :: ki
62 REAL,
DIMENSION(:,:),
INTENT(IN) :: pkappa
64 REAL,
DIMENSION(:),
INTENT(IN) :: pkappac
66 REAL,
DIMENSION(:),
INTENT(IN) :: pro_i
67 REAL,
DIMENSION(:,:),
INTENT(OUT):: pro_t
72 INTEGER :: jcat, jpix, jmesh_isba,jj
73 INTEGER,
DIMENSION(KI) :: insat
74 INTEGER,
DIMENSION(KI) :: indry
75 REAL,
DIMENSION(NNCAT,NMESHT) :: zrosat
76 REAL,
DIMENSION(NNCAT,NMESHT) :: zrodry
77 CHARACTER(LEN=30) :: yvar
79 REAL::zsmall,ztmp,ztmp2
80 REAL(KIND=JPRB) :: zhook_handle
82 IF (lhook) CALL dr_hook(
'ISBA_TO_TOPDSAT',0,zhook_handle)
98 jpix=nmaski(jmesh_isba,jcat,jj)
100 DO WHILE (jpix/=nundef .AND.(jj<=
SIZE(nmaski,3)))
102 IF (pkappa(jcat,jpix)/=xundef .AND. nmaskt(jcat,jpix)/=nundef)
THEN
104 IF (pkappa(jcat,jpix).GE.pkappac(jcat))
THEN
105 insat(nmaskt(jcat,jpix)) = insat(nmaskt(jcat,jpix)) + 1
106 zrosat(jcat,jpix) = pro_i(nmaskt(jcat,jpix))
108 indry(nmaskt(jcat,jpix)) = indry(nmaskt(jcat,jpix)) + 1
109 zrodry(jcat,jpix) = pro_i(nmaskt(jcat,jpix))
114 IF (jj<=
SIZE(nmaski,3)) jpix=nmaski(jmesh_isba,jcat,jj)
125 DO jpix = 1,nnmc(jcat)
127 IF (nmaskt(jcat,jpix)/=nundef)
THEN
129 IF (insat(nmaskt(jcat,jpix)).GT.0 .AND. pkappa(jcat,jpix)/=xundef)
THEN
130 pro_t(jcat,jpix) = zrosat(jcat,jpix) / insat(nmaskt(jcat,jpix))
132 ELSEIF (indry(nmaskt(jcat,jpix)).GT.0 .AND. pkappa(jcat,jpix)/=xundef)
THEN
133 pro_t(jcat,jpix) = zrodry(jcat,jpix) / indry(nmaskt(jcat,jpix))
135 pro_t(jcat,jpix) = 0.
145 DO jpix = 1,nnmc(jcat)
147 IF (pro_t(jcat,jpix)/=xundef) ztmp = ztmp + pro_t(jcat,jpix)
148 IF ( nmaskt(jcat,jpix)/=nundef)
THEN
149 IF (pro_i(nmaskt(jcat,jpix))/=xundef .AND. nnpix(nmaskt(jcat,jpix))/=0 ) &
150 ztmp2 = ztmp2 + pro_i(nmaskt(jcat,jpix)) / nnpix(nmaskt(jcat,jpix))
155 zsmall=abs(ztmp2*0.001)
157 IF( abs(ztmp-ztmp2) > zsmall )
THEN
158 WHERE ( pro_t(jcat,:)/=xundef )
159 pro_t(jcat,:) = pro_t(jcat,:)- ((ztmp-ztmp2)/nnmc(jcat))
165 IF (lhook) CALL dr_hook(
'ISBA_TO_TOPDSAT',1,zhook_handle)
subroutine isba_to_topdsat(PKAPPA, PKAPPAC, KI, PRO_I, PRO_T)