!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- !SUBROUTINE SUGOESALO(KULOUT) 1 #if defined (DOC) * ***s/r SUGOESALO : Memory allocation for the radiative transfer model * variables * *Author : N. Wagneur CMDA/MSC Mai 2001 * ------------------- ** Purpose: to allocate memory for the radiative transfer model variables. * * Revision: * * * * *Arguments * i : KULOUT : logical unit for output * #endif IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comct0.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "cparamgoes.cdk"
#include "comgoes.cdk"
#include "comjacgoes.cdk"
* EXTERNAL HPALLOC,HPDEALLC * INTEGER KULOUT,JO,IDATYP,ILEN,IER C C* 1. Determine the number of GOES to be assimilated. C . ----------------------------------------------- 100 CONTINUE NOBGOES = 0 DO JO = 1, NOBTOT IDATYP = MOD(MOBHDR(NCMITY,JO),1000) IF ( IDATYP .EQ. 180 ) THEN NOBGOES = NOBGOES + 1 ENDIF ENDDO c write(kulout,*) ' SUMSCFASTALO: nobgoes = ', nobgoes C C* 2. Memory allocation for radiate tranfer model variables C . ----------------------------------------------------- C 200 CONTINUE C C PTRTJAC = -1 PTMJOGO = -1 C IF ( CRTMODLGO .EQ. 'MSCFAST' ) THEN CALL HPALLOC(PTMJOGO,MAX(NOBGOES,1),IER,8) IF ( NCONF .NE. 121 .AND. NCONF .NE. 101 ) THEN ** Attention on pourrait vouloir ne pas remplir pour les 22 canaux C ILEN = NOBGOES * ( NIB2 - NIB1 + 1 ) ILEN = NOBGOES * JPNB * (NFLEV+1) * 2 CALL HPALLOC(PTRTJAC,MAX(ILEN,1),IER,8) ENDIF c ENDIF C C RETURN END