- Timestamp:
- 2012-11-19T13:28:55+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
r3294 r3594 36 36 !! 37 37 !! ** Method : restart.obc.output file: Direct access non formatted file. 38 !! Each n stock time step , save fields which are necessary for restart.38 !! Each nn_stock time step , save fields which are necessary for restart. 39 39 !! - This routine is called if at least the key_obc is defined. It is called 40 40 !! at the same time step than rstwrite. … … 73 73 ! ------------------------------------ 74 74 75 IF( ( mod(kt,nstock) == 0 ) .OR. ( kt == nitend ) ) THEN 76 77 ! 1.0 Initializations 78 ! ------------------- 79 IF(lwp) THEN 80 WRITE(numout,*) ' ' 81 WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_write routine' 82 WRITE(numout,*) '~~~~~~' 83 WRITE(numout,*) ' output done in restart.obc.output file at it= ', kt, ' date= ', ndastp 84 END IF 85 86 ino0 = no 87 it0 = kt 88 ibloc = 4096*4 89 nreclo = ibloc*( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1) 90 IF(lwp) WRITE(numout,*) ' ' 91 IF(lwp) WRITE(numout,*) ' OBC restart file opened with nreclo = ',nreclo 92 93 ! 1.1 Open file 94 ! ------------- 95 96 CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 97 98 ! 1.2 Write header 99 ! ---------------- 100 WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob, & 75 ! 1.0 Initializations 76 ! ------------------- 77 IF(lwp) THEN 78 WRITE(numout,*) ' ' 79 WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_write routine' 80 WRITE(numout,*) '~~~~~~' 81 WRITE(numout,*) ' output done in restart.obc.output file at it= ', kt, ' date= ', ndastp 82 END IF 83 84 ino0 = no 85 it0 = kt 86 ibloc = 4096*4 87 nreclo = ibloc*( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1) 88 IF(lwp) WRITE(numout,*) ' ' 89 IF(lwp) WRITE(numout,*) ' OBC restart file opened with nreclo = ',nreclo 90 91 ! 1.1 Open file 92 ! ------------- 93 94 CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 95 96 ! 1.2 Write header 97 ! ---------------- 98 WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob, & 101 99 jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf 102 100 103 ! 1.3 Write east boundary array if any. 104 ! ------------------------------------- 105 IF( lp_obc_east ) THEN 106 IF( lfbceast ) THEN 107 IF(lwp) THEN 108 WRITE(numout,*) ' ' 109 WRITE(numout,*) ' No restart file for the fixed east OBC' 101 ! 1.3 Write east boundary array if any. 102 ! ------------------------------------- 103 IF( lp_obc_east ) THEN 104 IF( lfbceast ) THEN 105 IF(lwp) THEN 106 WRITE(numout,*) ' ' 107 WRITE(numout,*) ' No restart file for the fixed east OBC' 108 END IF 109 ELSE 110 IF( jpieob /= 0 ) THEN 111 IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN 112 ! ... dump of jpjed if it is on this proc. 113 jrec = 2 114 jfoe = jpjed - njmpp + 1 115 PRINT *,'Narea =',narea,' write jrec =2 east' 116 WRITE(inum,REC=jrec) & 117 ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 118 ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 119 ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 120 ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 121 ENDIF 122 DO ji = nie0, nie1 123 DO jj = nje0, nje1 124 ! ... only interested processors go through the following lines 125 ! jfoe = jj + njmpp -1 126 jfoe = jj 127 jrec = 2 + jj + njmpp -1 -jpjed 128 WRITE (inum,REC=jrec) & 129 ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 130 ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 131 ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 132 ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 133 END DO 134 END DO 135 END IF 136 END IF 137 END IF 138 139 ! 1.4 Write west boundary arrays if any 140 ! ------------------------------------- 141 IF( lp_obc_west ) THEN 142 IF( lfbcwest ) THEN 143 IF(lwp) THEN 144 WRITE(numout,*) ' ' 145 WRITE(numout,*) ' No restart file for the fixed west OBC' 146 END IF 147 ELSE 148 IF( jpiwob /= 0 ) THEN 149 IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN 150 ! ... dump of jpjwd if it is on this proc. 151 jrec = 3 + jpjef - jpjed 152 ! jfow = jpjwd 153 jfow = jpjwd -njmpp + 1 154 PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 155 WRITE (inum,REC=jrec) & 156 ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 157 ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 158 ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 159 ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 110 160 END IF 111 ELSE 112 IF( jpieob /= 0 ) THEN 113 IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN 114 ! ... dump of jpjed if it is on this proc. 115 jrec = 2 116 jfoe = jpjed - njmpp + 1 117 PRINT *,'Narea =',narea,' write jrec =2 east' 118 WRITE(inum,REC=jrec) & 119 ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 120 ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 121 ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 122 ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 123 ENDIF 124 DO ji = nie0, nie1 125 DO jj = nje0, nje1 126 ! ... only interested processors go through the following lines 127 ! jfoe = jj + njmpp -1 128 jfoe = jj 129 jrec = 2 + jj + njmpp -1 -jpjed 130 WRITE (inum,REC=jrec) & 131 ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 132 ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 133 ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 134 ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 135 END DO 161 DO ji = niw0, niw1 162 DO jj = njw0, njw1 163 ! ... only interested processors go through the following lines 164 ! jfow = jj + njmpp -1 165 jfow = jj 166 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 167 WRITE (inum,REC=jrec) & 168 ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 169 ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 170 ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 171 ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 136 172 END DO 173 END DO 174 END IF 175 END IF 176 END IF 177 178 ! 1.5 Write north boundary arrays if any 179 ! -------------------------------------- 180 IF( lp_obc_north ) THEN 181 IF( lfbcnorth ) THEN 182 IF(lwp) THEN 183 WRITE(numout,*) ' ' 184 WRITE(numout,*) ' No restart file for the fixed north OBC' 185 END IF 186 ELSE 187 IF( jpjnob /= 0) THEN 188 IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN 189 ! ... dump of jpind if it is on this proc. 190 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd 191 ! ifon = jpind 192 ifon = jpind -nimpp +1 193 WRITE (inum,REC=jrec) & 194 ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 195 ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 196 ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 197 ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 137 198 END IF 138 END IF 139 END IF 140 141 ! 1.4 Write west boundary arrays if any 142 ! ------------------------------------- 143 IF( lp_obc_west ) THEN 144 IF( lfbcwest ) THEN 145 IF(lwp) THEN 146 WRITE(numout,*) ' ' 147 WRITE(numout,*) ' No restart file for the fixed west OBC' 199 DO jj = njn0, njn1 200 DO ji = nin0, nin1 201 ! ... only interested processors go through the following lines 202 ! ifon = ji + nimpp -1 203 ifon = ji 204 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 205 WRITE (inum,REC=jrec) & 206 ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 207 ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 208 ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 209 ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 210 END DO 211 END DO 212 END IF 213 END IF 214 END IF 215 216 ! 1.6 Write south boundary arrays if any 217 ! -------------------------------------- 218 IF( lp_obc_south ) THEN 219 IF( lfbcsouth ) THEN 220 IF(lwp) THEN 221 WRITE(numout,*) ' ' 222 WRITE(numout,*) ' No restart file for the fixed south OBC' 223 WRITE(numout,*) ' ' 224 END IF 225 ELSE 226 IF( jpjsob /= 0 ) THEN 227 IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN 228 ! ... dump of jpisd if it is on this proc. 229 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind 230 ! ifos = jpisd 231 ifos = jpisd -nimpp + 1 232 WRITE (inum,REC=jrec) & 233 ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 234 ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 235 ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 236 ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 148 237 END IF 149 ELSE 150 IF( jpiwob /= 0 ) THEN 151 IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN 152 ! ... dump of jpjwd if it is on this proc. 153 jrec = 3 + jpjef - jpjed 154 ! jfow = jpjwd 155 jfow = jpjwd -njmpp + 1 156 PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 157 WRITE (inum,REC=jrec) & 158 ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 159 ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 160 ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 161 ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 162 END IF 163 DO ji = niw0, niw1 164 DO jj = njw0, njw1 165 ! ... only interested processors go through the following lines 166 ! jfow = jj + njmpp -1 167 jfow = jj 168 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 169 WRITE (inum,REC=jrec) & 170 ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 171 ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 172 ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 173 ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 174 END DO 175 END DO 176 END IF 177 END IF 178 END IF 179 180 ! 1.5 Write north boundary arrays if any 181 ! -------------------------------------- 182 IF( lp_obc_north ) THEN 183 IF( lfbcnorth ) THEN 184 IF(lwp) THEN 185 WRITE(numout,*) ' ' 186 WRITE(numout,*) ' No restart file for the fixed north OBC' 187 END IF 188 ELSE 189 IF( jpjnob /= 0) THEN 190 IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN 191 ! ... dump of jpind if it is on this proc. 192 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd 193 ! ifon = jpind 194 ifon = jpind -nimpp +1 195 WRITE (inum,REC=jrec) & 196 ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 197 ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 198 ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 199 ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 200 END IF 201 DO jj = njn0, njn1 202 DO ji = nin0, nin1 203 ! ... only interested processors go through the following lines 204 ! ifon = ji + nimpp -1 205 ifon = ji 206 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 207 WRITE (inum,REC=jrec) & 208 ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 209 ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 210 ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 211 ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 212 END DO 213 END DO 214 END IF 215 END IF 216 END IF 217 218 ! 1.6 Write south boundary arrays if any 219 ! -------------------------------------- 220 IF( lp_obc_south ) THEN 221 IF( lfbcsouth ) THEN 222 IF(lwp) THEN 223 WRITE(numout,*) ' ' 224 WRITE(numout,*) ' No restart file for the fixed south OBC' 225 WRITE(numout,*) ' ' 226 END IF 227 ELSE 228 IF( jpjsob /= 0 ) THEN 229 IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN 230 ! ... dump of jpisd if it is on this proc. 231 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind 232 ! ifos = jpisd 233 ifos = jpisd -nimpp + 1 234 WRITE (inum,REC=jrec) & 238 DO jj = njs0, njs1 239 DO ji = nis0, nis1 240 ! ... only interested processors go through the following lines 241 ! ifos = ji + nimpp -1 242 ifos = ji 243 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + & 244 ji + nimpp -1 -jpisd 245 WRITE (inum,REC=jrec) & 235 246 ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 236 247 ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), & 237 248 ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 238 249 ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2) 239 END IF240 DO jj = njs0, njs1241 DO ji = nis0, nis1242 ! ... only interested processors go through the following lines243 ! ifos = ji + nimpp -1244 ifos = ji245 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &246 ji + nimpp -1 -jpisd247 WRITE (inum,REC=jrec) &248 ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &249 ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &250 ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &251 ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)252 END DO253 250 END DO 254 END IF255 END IF 256 END IF 257 CLOSE(inum)258 END IF251 END DO 252 END IF 253 END IF 254 END IF 255 CLOSE(inum) 259 256 260 257 END SUBROUTINE obc_rst_write
Note: See TracChangeset
for help on using the changeset viewer.
