Changeset 2841
- Timestamp:
- 2011-09-16T11:24:28+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r2839 r2841 57 57 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 58 58 ! 59 !IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 ) CALL flo_wri( kt ) ! trajectories file60 59 CALL flo_wri( kt ) ! trajectories file 61 !??IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 ) CALL flo_wri( kt ) ! restart file62 60 ! 63 61 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2839 r2841 96 96 !!---------------------------------------------------------------------- 97 97 98 !IF( MOD( kt,nn_writefl)== 0 ) THEN 99 100 101 !----------------------------------------------------- 102 ! I- Save positions, temperature, salinty and density 103 !----------------------------------------------------- 104 zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 105 ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 106 107 DO jfl = 1, jpnfl 108 109 iafl = INT (tpifl(jfl)) ! I-index of the nearest point before 110 ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before 111 icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before 112 ia1fl = iafl + 1 ! I-index of the nearest point after 113 ib1fl = ibfl + 1 ! J-index of the nearest point after 114 ic1fl = icfl + 1 ! K-index of the nearest point after 115 zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ????? 116 zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ????? 117 zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ????? 118 119 write(narea+200,*)'A', jfl,iafl,ibfl 120 121 IF( lk_mpp ) THEN 98 !----------------------------------------------------- 99 ! I- Save positions, temperature, salinty and density 100 !----------------------------------------------------- 101 zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 102 ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 103 104 DO jfl = 1, jpnfl 105 106 iafl = INT (tpifl(jfl)) ! I-index of the nearest point before 107 ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before 108 icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before 109 ia1fl = iafl + 1 ! I-index of the nearest point after 110 ib1fl = ibfl + 1 ! J-index of the nearest point after 111 ic1fl = icfl + 1 ! K-index of the nearest point after 112 zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ????? 113 zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ????? 114 zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ????? 115 116 IF( lk_mpp ) THEN 122 117 123 124 118 iafloc = mi1( iafl ) 119 ibfloc = mj1( ibfl ) 125 120 126 IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 127 & nldj <= ibfloc .AND. ibfloc <= nlej ) THEN 128 129 write(narea+200,*)'B',jfl,iafloc,ibfloc,glamt(iafloc ,ibfloc ) 130 write(narea+200,*)'B',zafl,zbfl 131 132 !the float is inside of current proc's area 133 ia1floc = iafloc + 1 134 ib1floc = ibfloc + 1 135 136 !save position of the float 137 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 138 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 139 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 140 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 141 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 142 143 !save temperature, salinity and density at this position 144 ztem(jfl) = tn(iafloc,ibfloc,icfl) 145 zsal (jfl) = sn(iafloc,ibfloc,icfl) 146 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 147 148 ELSE ! the float is not inside of current proc's area 149 !write(narea+200,*)"notinside current proc: jfl ",jfl 150 151 zlon(jfl) = 0. 152 zlat(jfl) = 0. 153 zdep(jfl) = 0. 154 155 !ztemp(1:jpk,jfl) = 0. 156 !zsal (1:jpk,jfl) = 0. 157 !zrho (1:jpk,jfl) = 0. 158 ztem(jfl) = 0. 159 zsal (jfl) = 0. 160 zrho (jfl) = 0. 161 162 ENDIF 163 164 ELSE ! mono proc case 165 166 iafloc = iafl 167 ibfloc = ibfl 121 IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 122 & nldj <= ibfloc .AND. ibfloc <= nlej ) THEN 123 124 !the float is inside of current proc's area 168 125 ia1floc = iafloc + 1 169 126 ib1floc = ibfloc + 1 170 171 !save position of the float 127 128 !save position of the float 172 129 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 173 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)130 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 174 131 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 175 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 176 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 177 132 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 133 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 134 135 !save temperature, salinity and density at this position 178 136 ztem(jfl) = tn(iafloc,ibfloc,icfl) 179 zsal(jfl) = sn(iafloc,ibfloc,icfl) 180 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 137 zsal (jfl) = sn(iafloc,ibfloc,icfl) 138 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 139 140 ELSE ! the float is not inside of current proc's area 141 142 zlon(jfl) = 0. 143 zlat(jfl) = 0. 144 zdep(jfl) = 0. 145 ztem(jfl) = 0. 146 zsal (jfl) = 0. 147 zrho (jfl) = 0. 148 149 ENDIF 150 151 ELSE ! mono proc case 152 153 iafloc = iafl 154 ibfloc = ibfl 155 ia1floc = iafloc + 1 156 ib1floc = ibfloc + 1 157 158 !save position of the float 159 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 160 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 161 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 162 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 163 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 164 165 ztem(jfl) = tn(iafloc,ibfloc,icfl) 166 zsal(jfl) = sn(iafloc,ibfloc,icfl) 167 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 181 168 182 ENDIF183 184 END DO ! loop on float185 186 IF( lk_mpp ) THEN187 188 ! Only proc 0 writes all positions189 190 !SUM of positions on all procs191 write(narea+200,*)"zlon avt mpp_sum ",zlon192 CALL mpp_sum( zlon, jpnfl ) ! sums over the global domain193 write(narea+200,*)"zlon apr mpp_sum ",zlon194 CALL mpp_sum( zlat, jpnfl ) ! sums over the global domain195 CALL mpp_sum( zdep, jpnfl ) ! sums over the global domain196 CALL mpp_sum( ztem, jpnfl ) ! sums over the global domain197 CALL mpp_sum( zsal, jpnfl ) ! sums over the global domain198 CALL mpp_sum( zrho, jpnfl ) ! sums over the global domain199 200 169 ENDIF 201 170 202 203 !ENDIF !end of saving variables 204 205 206 !---------------------------------! 207 ! WRITE WRITE WRITE WRITE WRITE ! 208 !---------------------------------! 209 210 !----------------------------------------------------- 211 ! II- Write in ascii file 212 !----------------------------------------------------- 171 END DO ! loop on float 172 173 !Only proc 0 writes all positions : SUM of positions on all procs 174 IF( lk_mpp ) THEN 175 CALL mpp_sum( zlon, jpnfl ) ! sums over the global domain 176 CALL mpp_sum( zlat, jpnfl ) ! sums over the global domain 177 CALL mpp_sum( zdep, jpnfl ) ! sums over the global domain 178 CALL mpp_sum( ztem, jpnfl ) ! sums over the global domain 179 CALL mpp_sum( zsal, jpnfl ) ! sums over the global domain 180 CALL mpp_sum( zrho, jpnfl ) ! sums over the global domain 181 ENDIF 182 183 184 !-------------------------------------! 185 ! II- WRITE WRITE WRITE WRITE WRITE ! 186 !-------------------------------------! 187 188 !--------------------------! 189 ! II-1 Write in ascii file ! 190 !--------------------------! 213 191 214 192 IF( ln_flo_ascii )THEN -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r2839 r2841 969 969 CHARACTER(LEN=*) , INTENT(in) :: cdname 970 970 REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d 971 INTEGER :: jp n971 INTEGER :: jpz 972 972 #if defined key_iomput 973 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpn/) ) ) 973 jpz=SIZE(pfield1d) 974 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 974 975 #else 975 976 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
Note: See TracChangeset
for help on using the changeset viewer.