*IF DEF,CONTROL,AND,DEF,ATMOS RESETAT1.2
C ******************************COPYRIGHT****************************** GTS2F400.8245
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8246
C GTS2F400.8247
C Use, duplication or disclosure of this code is subject to the GTS2F400.8248
C restrictions as set forth in the contract. GTS2F400.8249
C GTS2F400.8250
C Meteorological Office GTS2F400.8251
C London Road GTS2F400.8252
C BRACKNELL GTS2F400.8253
C Berkshire UK GTS2F400.8254
C RG12 2SZ GTS2F400.8255
C GTS2F400.8256
C If no contract has been raised with this copy of the code, the use, GTS2F400.8257
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8258
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8259
C Modelling at the above address. GTS2F400.8260
C ******************************COPYRIGHT****************************** GTS2F400.8261
C GTS2F400.8262
CLL Subroutine: RESETATM ---------------------------------------------- RESETAT1.3
CLL RESETAT1.4
CLL Purpose: Control routine to perform recalculations of prognostic RESETAT1.5
CLL quantities following dump. For reproducibility, various RESETAT1.6
CLL fields need to be recalculated using rounded values. RESETAT1.7
CLL RESETAT1.8
CLL Tested under compiler: cft77 RESETAT1.9
CLL Tested under OS version: UNICOS 5.1 RESETAT1.10
CLL RESETAT1.11
CLL Author: T.C.Johns RESETAT1.12
CLL RESETAT1.13
CLL Model Modification history from model version 3.0: RESETAT1.14
CLL version date RESETAT1.15
CLL 3.1 8/02/93 : added comdeck CHSUNITS to define NUNITS for RS030293.218
CLL comdeck CCONTROL. RS030293.219
CLL 3.2 27/03/93 Dynamic allocation of main data arrays. R. Rawlins @DYALLOC.3192
CLL RESETAT1.16
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) RESETAT1.17
CLL RESETAT1.18
CLL Logical components covered: C0 RESETAT1.19
CLL RESETAT1.20
CLL Project task: C0 RESETAT1.21
CLL RESETAT1.22
CLL External documentation: On-line UM document C0 - The top-level RESETAT1.23
CLL control system RESETAT1.24
CLL RESETAT1.25
CLL ------------------------------------------------------------------- RESETAT1.26
C*L Interface and arguments: ------------------------------------------ RESETAT1.27
C RESETAT1.28
SUBROUTINE RESETATM( 1,6@DYALLOC.3193
*CALL ARGSZSP 
@DYALLOC.3194
*CALL ARGSZSPA @DYALLOC.3195
*CALL ARGSP @DYALLOC.3196
*CALL ARGSPA @DYALLOC.3197
*CALL ARGSIZE @DYALLOC.3198
& ICODE,CMESSAGE) @DYALLOC.3199
C RESETAT1.30
IMPLICIT NONE RESETAT1.31
INTEGER ICODE ! OUT - error return code RESETAT1.32
CHARACTER*256 CMESSAGE ! OUT - error message @DYALLOC.3200
C @DYALLOC.3201
*CALL TYPSZSP @DYALLOC.3202
*CALL TYPSZSPA @DYALLOC.3203
*CALL TYPSP @DYALLOC.3204
*CALL TYPSPA @DYALLOC.3205
*CALL TYPSIZE @DYALLOC.3206
CL Addresses of arrays within super arrays @DYALLOC.3207
*CALL SPINDEX @DYALLOC.3208
CL @DYALLOC.3209
C*---------------------------------------------------------------------- RESETAT1.34
C RESETAT1.35
C Common blocks RESETAT1.36
C RESETAT1.37
*CALL CSUBMODL GDR3F305.165
*CALL CHSUNITS RS030293.220
*CALL CCONTROL RESETAT1.38
C RESETAT1.40
C Subroutines called RESETAT1.41
C RESETAT1.42
EXTERNAL SETLSCLD RESETAT1.43
*IF DEF,REPROD RESETAT1.44
& ,SETEXNER RESETAT1.45
*ENDIF RESETAT1.46
C RESETAT1.47
*IF DEF,REPROD RESETAT1.48
CL---------------------------------------------------------------------- RESETAT1.49
CL 1. Recalculate PEXNER RESETAT1.50
CL RESETAT1.51
IF (LTIMER) CALL TIMER('SETEXNER',3) RESETAT1.52
CALL SETEXNER( @DYALLOC.3210
*CALL ARGSIZE @DYALLOC.3211
*CALL ARTD1 @DYALLOC.3212
*CALL ARTPTRA @DYALLOC.3213
*CALL ARTCONA @DYALLOC.3214
& ICODE,CMESSAGE) @DYALLOC.3215
IF (LTIMER) CALL TIMER('SETEXNER',4) RESETAT1.54
*ENDIF RESETAT1.55
CL---------------------------------------------------------------------- RESETAT1.56
CL 2. Recalculate cloud liquid and frozen water, starting from dumped RESETAT1.57
CL fields which have been rounded to 32-bit precision RESETAT1.58
CL RESETAT1.59
IF (LTIMER) CALL TIMER('SETLSCLD',3) RESETAT1.60
CALL SETLSCLD( @DYALLOC.3216
*CALL ARGSIZE @DYALLOC.3217
*CALL ARTD1 @DYALLOC.3218
*CALL ARTDUMA @DYALLOC.3219
*CALL ARTPTRA @DYALLOC.3220
*CALL ARTCONA @DYALLOC.3221
& P_FIELD, Q_LEVELS, ! for portable dynamic arrays NF171193.47
& ICODE,CMESSAGE) @DYALLOC.3222
IF (LTIMER) CALL TIMER('SETLSCLD',4) RESETAT1.62
IF (ICODE.GT.0) GOTO 999 RESETAT1.63
C RESETAT1.64
999 CONTINUE RESETAT1.65
RETURN RESETAT1.66
END RESETAT1.67
*ENDIF RESETAT1.68