*IF DEF,C80_1A,OR,DEF,RECON SDFADR1A.2
C ******************************COPYRIGHT****************************** SDFADR1A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SDFADR1A.4
C SDFADR1A.5
C Use, duplication or disclosure of this code is subject to the SDFADR1A.6
C restrictions as set forth in the contract. SDFADR1A.7
C SDFADR1A.8
C Meteorological Office SDFADR1A.9
C London Road SDFADR1A.10
C BRACKNELL SDFADR1A.11
C Berkshire UK SDFADR1A.12
C RG12 2SZ SDFADR1A.13
C SDFADR1A.14
C If no contract has been raised with this copy of the code, the use, SDFADR1A.15
C duplication or disclosure of it is strictly prohibited. Permission SDFADR1A.16
C to do so must first be obtained in writing from the Head of Numerical SDFADR1A.17
C Modelling at the above address. SDFADR1A.18
C ******************************COPYRIGHT****************************** SDFADR1A.19
C SDFADR1A.20
CLL Routine: SDFADR1A ------------------------------------------------ SDFADR1A.21
CLL SDFADR1A.22
CLL Purpose: To set the LBEGIN and LBNREC fields in the LOOKUP Headers SDFADR1A.23
CLL for VN 16 Type Dumpfiles - addressed by location and SDFADR1A.24
CLL length which are rounded up the 'UM_SECTOR_SIZE' to make SDFADR1A.25
CLL Well-Formed I/O Requests. SDFADR1A.26
CLL SDFADR1A.27
CLL Author: Bob Carruthers, Cray Research. Date: 20 May 1997 SDFADR1A.28
CLL SDFADR1A.29
CLL Modifications GCJ2F405.65
CLL V4.5 Check that there are data in file. C.P. Jones 12 Feb 1998 GCJ2F405.66
CLL GCJ2F405.67
CLL ------------------------------------------------------------------- SDFADR1A.30
C*L Interface and arguments: ------------------------------------------ SDFADR1A.31
subroutine set_dumpfile_address(fixhd, len_fixhd, 21,1SDFADR1A.32
& lookup, len1_lookup, len2_lookup, SDFADR1A.33
& number_of_data_words_in_memory, SDFADR1A.34
& number_of_data_words_on_disk, SDFADR1A.35
& disk_address) SDFADR1A.36
c SDFADR1A.37
implicit none SDFADR1A.38
SDFADR1A.39
integer SDFADR1A.40
& len_fixhd ! IN Length of fixed length SDFADR1A.41
! header SDFADR1A.42
&,len1_lookup ! IN 1st dim of lookup SDFADR1A.43
&,len2_lookup ! IN 2nd dim of lookup SDFADR1A.44
&,number_of_data_words_in_memory ! OUT Number of Data Words SDFADR1A.45
! in memory SDFADR1A.46
&,number_of_data_words_on_disk ! OUT Number of data words SDFADR1A.47
! on disk SDFADR1A.48
&,disk_address ! OUT Current rounded disk SDFADR1A.49
! address and final data SDFADR1A.50
! length SDFADR1A.51
SDFADR1A.52
integer SDFADR1A.53
& fixhd(len_fixhd) !IN Fixed length header SDFADR1A.54
&,lookup(len1_lookup,len2_lookup) !IN/OUT PP lookup tables SDFADR1A.55
SDFADR1A.56
*CALL CLOOKADD 
SDFADR1A.57
*CALL CNTL_IO SDFADR1A.58
*CALL PARVARS SDFADR1A.59
SDFADR1A.60
integer SDFADR1A.61
& disk_length ! current data length on disk SDFADR1A.62
&,i ! Loop Index SDFADR1A.63
&,old_fixhd_160 ! Original value of fixhd(160) SDFADR1A.64
! checking as the new addresses SDFADR1A.65
! are computed SDFADR1A.66
SDFADR1A.67
c SDFADR1A.68
if(fixhd(160).lt.0) RETURN GCJ2F405.68
GCJ2F405.69
c--check that the initial data address has been rounded up SDFADR1A.69
c to a sector boundary - REMEMBER all the code removes SDFADR1A.70
c one from this address because addresses start at zero. SDFADR1A.71
if((fixhd(160)-1) .ne. SDFADR1A.72
2 (((fixhd(160)-1)+um_sector_size-1)/um_sector_size)* SDFADR1A.73
3 um_sector_size) then SDFADR1A.74
c--save the current initial data address SDFADR1A.75
old_fixhd_160=fixhd(160) SDFADR1A.76
c--round up the initial disk address SDFADR1A.77
fixhd(160)=(((fixhd(160)-1)+um_sector_size-1)/ SDFADR1A.78
2 um_sector_size)*um_sector_size+1 SDFADR1A.79
*IF DEF,DIAG92 SDFADR1A.80
*IF DEF,MPP SDFADR1A.81
if(mype.eq.0) then SDFADR1A.82
*ENDIF SDFADR1A.83
write(6,900) old_fixhd_160-1, fixhd(160)-1 SDFADR1A.84
900 format(/'SET_DUMPFILE_ADDRESS: Start of Data Address', SDFADR1A.85
2 ' on Disk reset from ',i10,' to ',i10) SDFADR1A.86
*IF DEF,T3E SDFADR1A.87
write(0,900) old_fixhd_160-1, fixhd(160)-1 SDFADR1A.88
*ENDIF SDFADR1A.89
*IF DEF,MPP SDFADR1A.90
endif SDFADR1A.91
*ENDIF SDFADR1A.92
*ENDIF SDFADR1A.93
endif SDFADR1A.94
c SDFADR1A.95
c--adjust the Dumpfile version Number SDFADR1A.96
c if(fixhd(1).lt.16) fixhd(1)=16 SDFADR1A.97
c SDFADR1A.98
c--count the number of words on disk and in memory SDFADR1A.99
number_of_data_words_on_disk=0 SDFADR1A.100
number_of_data_words_in_memory=0 SDFADR1A.101
c SDFADR1A.102
c--find the initial data location on disk SDFADR1A.103
disk_address=fixhd(160)-1 SDFADR1A.104
c SDFADR1A.105
c--loop over all the entries and alter the addresses and lengths SDFADR1A.106
do i=1, len2_lookup SDFADR1A.107
c--check for a PP type file with an incomplete lookup table SDFADR1A.108
if(lookup(1, i).eq.-99) goto 200 SDFADR1A.109
c--check for packing to 32-bits SDFADR1A.110
if(lookup(lbpack,i)- SDFADR1A.111
2 ((lookup(lbpack,i)/10)*10).eq.2) then SDFADR1A.112
disk_length=(lookup(lblrec,i)+1)/2 SDFADR1A.113
else SDFADR1A.114
disk_length=lookup(lblrec,i) SDFADR1A.115
endif SDFADR1A.116
c--count the number of words SDFADR1A.117
number_of_data_words_on_disk= SDFADR1A.118
2 number_of_data_words_on_disk+disk_length SDFADR1A.119
number_of_data_words_in_memory= SDFADR1A.120
2 number_of_data_words_in_memory+lookup(lblrec,i) SDFADR1A.121
c--round up the length to a number of sectors SDFADR1A.122
disk_length=((disk_length+um_sector_size-1)/ SDFADR1A.123
2 um_sector_size)*um_sector_size SDFADR1A.124
c--set the disk address SDFADR1A.125
lookup(lbegin,i)=disk_address SDFADR1A.126
c--set the disk length SDFADR1A.127
lookup(lbnrec,i)=disk_length SDFADR1A.128
c--increment the disk address SDFADR1A.129
disk_address=disk_address+lookup(lbnrec,i) SDFADR1A.130
end do SDFADR1A.131
c--escape for PP type files SDFADR1A.132
200 continue SDFADR1A.133
c SDFADR1A.134
*IF DEF,DIAG92 SDFADR1A.135
*IF DEF,MPP SDFADR1A.136
if(mype.eq.0) then SDFADR1A.137
*ENDIF SDFADR1A.138
c--find the number of bytes in a word SDFADR1A.139
call word_length(i) SDFADR1A.140
c--print the diagnostic message SDFADR1A.141
write(6,1000) fixhd(161), number_of_data_words_in_memory, SDFADR1A.142
2 number_of_data_words_on_disk, disk_address-fixhd(160), SDFADR1A.143
3 disk_address, disk_address*i SDFADR1A.144
1000 format(/'SET_DUMPFILE_ADDRESS: Dumpfile LOOKUP Address', SDFADR1A.145
2 ' and Lengths Rewritten:'// SDFADR1A.146
3 i10,' Words Stored as Data Length in FIXHD(161)'/ SDFADR1A.147
4 i10,' Words Used in Memory for Data'/ SDFADR1A.148
5 i10,' Words Used on Disk for Data'/ SDFADR1A.149
6 i10,' Words Used on Disk for Data after Rounding'/ SDFADR1A.150
7 i10,' Words Used on Disk in Total for the File', SDFADR1A.151
8 ' (',i11,' Bytes)'/) SDFADR1A.152
*IF DEF,T3E SDFADR1A.153
write(0,1000) fixhd(161), number_of_data_words_in_memory, SDFADR1A.154
2 number_of_data_words_on_disk, disk_address-fixhd(160), SDFADR1A.155
3 disk_address, disk_address*i SDFADR1A.156
*ENDIF SDFADR1A.157
*IF DEF,MPP SDFADR1A.158
endif SDFADR1A.159
*ENDIF SDFADR1A.160
*ENDIF SDFADR1A.161
return SDFADR1A.162
end SDFADR1A.163
*ENDIF SDFADR1A.164